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1.  Introduction 
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FFT  is  an  easy-to-use  computer  program  for  the  IBM  PC/XT/AT  designed 
to  perform  data  analysis  on  waveforms.  This  package  was  developed  at 
the  Harry  Diamond  Laboratories  (HDL)  as  a  tool  for  analyzing 
electromagnetic  pulse  (EMP)  waveforms;  it  can,  however,  be  used  for  any 
physically  realizable  waveforms.  Some  of  the  data  analysis  options  in¬ 
clude  linear  and  cubic  spline  interpolation,  fast  Fourier  transforms 
(FFT’s),  inverse  FFT’s,  and  numerical  integration  and  differentation.  The 
program  also  graphs  data  waveforms  on  the  screen  or  on  an  Epson- 
compatible  printer  using  linear,  logarithmic,  or  semilog  graphs.  Addition¬ 
ally,  the  program  reads  and  writes  data  files  to  disk,  or  data  may  be 
manually  entered  through  a  digitizing  pad. 


The  software  package  FFT  was  written  to  provide  an  easy-to-use  method 
of  data  analysis  for  both  the  experienced  and  inexperienced  computer 
operator.  All  functions  are  menu  driven,  clearly  labelled,  and  simple  to 
invoke,  providing  an  easy-to-leam  and  easy-to-use  interface  to  a  collec¬ 
tion  of  powerful  routines. 


2.  System  Description 


2.1  Hardware 

The  software  presented  in  this  report  was  written  for  an  IBM  PC/XT/AT 
or  true  compatible,  using  either  a  standard  color  monitor  (640  x  200 
resolution)  or  the  Hercules  graphics  adapter  and  monitor  (720  x  350 
resolution).  A  hard  disk,  while  not  absolutely  necessary,  is  strongly  en¬ 
couraged.  Additionally,  the  use  of  the  Intel  80x87  math  coprocessor  is 
strongly  encouraged,  since  this  chip  will  greatly  increase  the  speed  and 
improve  the  accuracy  of  the  output  of  the  program  (see  table  1). 

The  digitizer  used  for  the  manual  digitization  process  is  the  Micro  Digi- 
Pad.*  This  is  a  type  7  absolute  electromagnetic  6  by  6  in.  digitizer.  Other 
digitizers  may  be  substituted  for  this  one  if  the  appropriate  constants  are 
set  in  the  software  (e.g.,  baud  rate,  number  of  start  and  stop  bits,  and  num¬ 
ber  of  data  bits). 


Tabk:  1.  Comparison 


of  real  numbers  gener¬ 

With 

Without 

ated  with  and  without 

Feature 

80x87 

80x87 

an  80x87  math 

coprocessor. 

Mantissa 

63  bits 

40  bits 

Characteristic 

1.5  bits 

8  bits 

Accuracy 

19  digits 

1 1  digits 

Smallest  real 

1.9 

1  X  10"“ 

Largest  real 

1.1  X  lO'”" 

1  X  lO” 

2.2  Software 

The  software  was  written  in  Turbo  Pascal  version  4.00  (see  bibliography)t 
and  was  developed  under  PC-DOS  3.1.  Note  that  these  low-level  graphics 
routines  were  written  explicitly  for  either  the  Hercules  graphics  adapter  or 
for  one  of  the  IBM  color  graphics  adapters,  and  hence  will  not  operate 
with  graphics  boards  which  are  not  compatible  with  one  of  these. 

The  following  files  must  be  on  the  current  directory  of  the  logged  drive  for 
this  program  to  be  used: 

FFT.EXE 

FFT.cfg  (optional  configuration  file) 


*From  GTCO  Corporation,  1055  First  Street,  Rockville,  MD  20850. 
f  Produced  by  Borland  International,  4585  Scoits  Valley  Drive,  Scotts  Valley,  CA  95066. 
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In  addition,  for  graphs  to  be  printed,  the  DOS  program  GRAPHICS.COM 
must  be  able  to  be  run  when  program  FFT  is  started. 

2.3  File  Structure 

Each  data  file  contains  three  parts:  an  identifier,  the  data  points,  and  an  in¬ 
formation  field.  The  identifier  simply  tells  the  number  of  data  points,  n,  in 
a  file.  The  data  points  are  listed  in  one  of  two  ways  (depending  on 
whether  the  data  were  transformed  or  not); 


t-  y-  (time-domain  data) 

t-  y-  /•  m-  p-  (frequency-domain  data) 

where 


t-  =  1th  data  point. 

1  <  1  <  n. 

y-  =  amplitude  at  t-. 

1  <  i  <  n. 

f-  =  ith  frequency  point. 

1  <  1  <  n/2. 

m-  =  magnitude  at/j. 

1  <  1  <  nil. 

p.  =  phase  at/.. 

1  <i<n/2. 

The  information  field  contains  several  information  lines.  These  lines  are 
intended  only  for  reference,  and  they  are  just  for  the  convenience  of  the 
user.  Table  2  is  an  example  of  an  input  data  file. 


Table  2.  Example  of 
an  input  file. 
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0.00 

0.00 

1.00 

0.00 

1.01 

1.00 

3.00 

1.00 

3.01 

0.00 

5.00 

0.00 

5.01 

1.00 

7.00 

1.00 

7.01 

().(X) 

8.00 

0.00 

4s  square  wave 
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3.  Users’  Manual 


The  user  starts  the  program  by  typing  "FFT"  at  the  DOS  prompt  (e.g., 
C:>),  bringing  up  the  main  menu  (see  fig.  1 ).  Each  of  the  program’s  sev¬ 
eral  options,  described  separately  below,  may  be  accessed  from  this  menu. 


Figure  1.  Main  menu, 
entry  pnint  of  FFT 
program. 


Main  Menu  (3.00) 

Select  Option  by  typing  a  number: 

1.  Digitizer 

2 .  Retrieve/Save  Data 

3.  Signal  Processing 

4 .  Graph  Results 

5 .  Advanced  Options 

6.  Create  Waveform 
9.  Exit  to  System 

Your  Choice? 


3.1  Option  1:  Digitization 

Digitization  is  selected  from  the  main  menu  when  the  user  wishes  to 
manually  digitize  a  photo.  To  begin  the  digitization  process,  the  photo  to 
be  digitized  is  first  placed  in  the  digitizer’s  drawing  area  and  secured  in 
place.  The  program  asks  first  for  the  left  and  right  endpoints  of  the  .x-axis, 
and  then  for  the  top  and  bottom  endpoints  of  the  y-axis.  Once  the  coor¬ 
dinate  axes  have  been  entered,  the  user  enters  (jc,y)  coordinate  pairs,  fol¬ 
lowing  these  general  guidelines: 

(1)  For  each  point  (.x-.y,),  it  is  necessary  that 

.Xi-i  <Xi  <Xr  , 

where  x^  is  the  right  endpoint  of  the  .x-axis. 

(2)  Near  points  where  the  curve  changes  direction,  the  curve  should  be 
sampled  more  frequently. 


j; 
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(3)  Pressing  ESCAPE  erases  an  incorrectly  entered  point. 

(4)  Pressing  ENTER  flnishes  the  digitization  process. 

After  all  the  points  are  entered,  the  user  is  asked  to  enter  the  total  time  and 
amplitude  displayed.  These  values  may  be  input  as  simple  real  numbers 
(e.g.,  "0.01"),  or  as  numbers  with  scale  multipliers  and/or  units  (e.g., 
"10mA"-see  table  3).  Once  these  values  are  entered,  the  computer 
redraws  the  wavefomi,  then  waits  for  a  key  to  be  pressed  to  return  to  the 
main  menu.  (If  the  results  are  unsatisfactory,  the  entire  process  should  be 
restarted.) 


Table  3.  Scale  multi¬ 

pliers  with  their  real- 
number  equivalents. 

Scale  mullipliers 

Value 

P 

itr'^ 

n 

Itr’ 

u 

itr'^ 

m 

itr’ 

k 

i(f^ 

M 

i(f* 

G 

t(f’ 

T 

10^" 

In  program  FFT,  values  may  be  entered 
with  or  without  units  using  the  standard 
meU'ic  prefixes  (except  that  p  becomes  u). 

Note  that  these  values  are  ca.sc-depcndent; 
that  is,  m  and  M  have  different  values. 

3.2  Option  2:  File  Operations 

Selection  of  option  2  from  the  main  menu  will  bring  up  the  file  I/O  menu 
(see  fig.  2).  From  here  the  user  can  save  a  waveform  to  disk,  retrieve  it 
from  disk,  or  delete  it  from  disk  by  simply  choosing  the  desired  action 
from  the  menu  choices  and  typing  the  filename  when  prompted.  The  user 
may  additionally  read  a  disk  directory  or  display  the  file  information  lines. 
The  filename  can  be  up  to  64  characters  long,  including  a  drive  and  path  if 
desired,  in  the  form  d:\full\path\filename.ext.  (If  either  the  drive  or  the 
path  is  not  specified,  then  the  program  will  search  the  current  data  drive  or 
path,  respectively,  for  the  file.)  If  the  program  detects  an  error  (for  ex¬ 
ample,  disk  is  full),  a  brief  error  message  will  be  displayed. 


Figure  2.  File  I/O 
menu.  All  disk  input/ 
output  is  done  from 
here. 


3.3  Option  3:  Signal  Processing 

The  first  time  the  signal  processing  functions  are  called,  the  data  are  inter¬ 
polated,  using  either  cubic  spline  interpolation  (the  default)  or  linear  inter¬ 
polation.  Once  the  interpolation  process  is  complete,  the  signal  processing 
menu  appears  (see  fig.  3).  From  this  menu,  any  of  several  data  analysis 
techniques  may  be  applied. 

While  most  of  the  functions  are  self-explanatory,  a  few  remarks  must  be 
made: 

( 1 )  Signal  processing  option  3:  When  an  FFT  is  performed,  the  prompt 
"Apply  window  IH/R/N|?"  appears.  If  the  data  are  nonzero  at  both  the  be¬ 
ginning  and  the  end  of  the  waveform,  selecting  "H"  (Hanning  window) 
will  force  both  ends  of  the  data  to  zero.  If  the  beginning  of  the  data  is  zero 
but  the  end  is  not,  selecting  "R"  (rear  window)  will  force  the  end  of  the 
data  to  zero.  If  both  ends  of  the  data  are  zero,  selecting  "N"  will  leave  the 
data  unchanged  (this  is  the  default). 

(2)  Signal  processing  option  5:  The  transfer  function  scales  a  waveform. 
The  scale  factor  must  be  of  the  form 

arm 


File  I/O  Menu 

Select  Option  by  typing  a  number: 

1. 

Save  Data  to  disk 

2. 

Retrieve  Data  from  disk 

3. 

Delete  Data  from  disk 

4  . 

Import  DDT  file  from  disk 

5. 

Disk  Directory 

6. 

Display  Information  Lines 

9. 

Exit  to  Main  Menu 

Your  choice? 
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o  =  operation  (+,  *,  /) 

r  =  real  number  (e.g.,  10, 0.24,  le-3) 
m  =  optional  multiplier  (see  table  2). 


Figure  3.  Signal  pnic- 
essing  menu.  All  data 
analysis  is  accom¬ 
plished  from  here. 


There  should  be  no  spaces  in  this  scale  factor.  Examples  of  this  function: 

+0.01  ->/(/)  =/(r)  + 0.01 
*lu->/(r)  =f(t)  xl0~^ 

The  scale  factor  can  be  applied  to  either  axis. 

Select  signal  processing  option  9  to  return  to  the  main  menu. 

signal  Processing  Menu 
Select  Option  by  typing  a  number: 

1.  Integrate 

2.  Differentiate 

3.  FFT 

4 .  Inverse  FFT 

5.  Transfer  Function 

6.  Remove  DC  Level 
9.  Exit  to  Main  Menu 

Your  Choice? 


Option  4:  (iraph  Results 

This  option  will  graph  the  current  waveform.  Graphs  may  be  of  one  of 
four  types: 

1.  linear . X-axis,  linear  y-axis, 

2.  log  x-axis,  log  y-axis, 

3.  log -V-axis,  linear  y-axis, 

4.  linear .x-axis,  logy-axis. 


Time-domain  data  will  default  to  a  linear  (type  1)  graph,  the  magnitude  of 
frequency-domain  data  will  default  to  a  log  (type  2)  graph,  and  the  phase 
of  the  frequency-domain  data  will  default  to  a  log-linear  (type  3)  graph. 
(Phase  can  only  be  plotted  on  a  linear  or  log-linear  graph.)  If  an  FFT  has 
been  performed  on  the  data,  the  prompt  "Time,  Magnitude,  or  Phase  |T/ 
M/P]?"  will  appear.  (Time  and  magnitude  are  the  most  common  displays; 
phase  is  included  only  for  completeness.) 

The  program  graphs  the  waveform  in  the  upper  two  thirds  of  the  screen. 
The  user  may  then  opt  to  print  the  graph,  with  a  title  and  subtitle,  or 
change  either  the  type  of  plot  or  the  interval  boundaries  of  the  plot,  from 
the  prompts  on  screen.  When  finished  viewing  the  graph,  the  user  may  re¬ 
turn  to  the  main  menu  by  selecting  option  9. 

Option  5:  Advanced  Options 

Advanced  options  allow  the  user  to  change  several  default  values  of  the 
program  (see  fig.  4).  Defaults  that  may  be  changed  are  the  type  of  inter¬ 
polation  to  be  performed,  to  which  port  the  digitizer  is  connected,  whether 
a  printer  is  installed  or  not,  the  background  and  foreground  screen  colors 
(on  color  monitors),  and  the  data  disk/directory.  Options  can  be  saved. 
Saved  options  are  read  at  program  startup.  All  changes  are  made  from  the 
advanced  options  menu. 

On  the  menu,  the  user  is  asked  to  choose  the  digitizer  port:  "[0/1/2]? 
Here,  "0"  refers  to  no  digitizer,  "1"  to  a  digitizer  on  COMl,  and  "2"  to  a 
digitizer  on  COM2.  Type  in  the  appropriate  number. 

Example  Session 

The  following  example  assumes  that  a  waveform  is  on  file,  but  you  could 
also  have  created  a  waveform  using  the  create  waveform  menu  (see  fig.  5). 
This  menu  is  accessed  from  the  main  menu  (fig.  1),  and  is  used  to  create 
general  mathematical  and  analytical  waveforms. 

In  this  example,  we  assume  that  there  is  a  4-MHz  sine  wave  in  file  SINE. 
RAW  on  drive  A.  You  want  to  perfomi  an  FFT  and  then  an  inverse  FFT 
on  the  wave,  and  store  the  results  in  file  SINE.FFT  on  drive  A.  From  the 
DOS  prompt  (C:>)  type  FFT  to  enter  the  data  analysis  program.  This 
brings  you  to  the  main  menu  (see  fig.  1).  Choose  opuon  5  (advanced  op- 
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Figure  4.  Advanced 
options  menu.  All 
system  parameters  are 
modified  here. 


Figures.  Create 
waveform  menu.  All 
analytic  waveforms 
are  created  from  this 
menu. 


Advanced  Options 

Select  Option  by  typing  a  number: 

1.  Linear/Spline  Interpolation:  S 

2.  Digitizer  Port  [0/1/2]:  1 

3.  Printer  installed  (y/n)  ?  N 

4.  Colors:  10/  1/  7 

5.  Data  Disk/Directory:  c: 

6.  Save  Options 

9.  Exit  to  Main  Menu 

your  Choice? 


Create  Waveform  Menu 
Select  waveform  to  create  by  typing  a  number. 

1.  Damped  Sine  Wave 

2.  EMP  Double  Exponential 

3.  Reciprocal  Double  Exponential 

4.  General  Exponential  Sum 
9.  Exit  to  Main  Menu 


Your  Choice? 


tions)  to  get  to  the  advanced  options  menu,  then  option  5  to  change  the 
default  data  disk  directory.  Type  A;<ENTER>.  Next,  choose  option  9  to 
return  to  the  main  menu,  then  choose  option  2  (retrieve/save  data)  to  get  to 
the  file  I/O  menu  (see  fig.  2),  then  option  2  (retrieve  data  from  disk). 
When  prompted  for  a  filename,  type  A:SINE.RAW  <ENTER>.  After  the 
file  is  read  from  the  disk,  you  are  returned  to  the  main  menu. 

Before  performing  an  FFT  on  the  data,  take  a  look  at  its  graph  by  choosing 
option  4  (graph  results)  from  the  main  menu.  Choosing  option  1  (print 
screen)  gives  you  the  graph  in  figure  6. 
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Figure  6.  A  4>IVIHz 
sine  wave  in  time 
domain. 


(xlO*^  )  seconds 

Next  choose  option  9  to  return  to  the  main  menu,  then  option  3  (signal 
processing)  to  get  to  the  signal  processing  menu  (see  fig.  3).  From  the  sig¬ 
nal  processing  menu,  choose  option  3  (FFT)  to  perform  an  FFT  on  the 
waveform.  Since  the  sine  wave  both  starts  and  ends  at  zero,  no  window 
need  be  applied,  so  answer  "N"  to  the  window  prompt. 

When  the  FFT  is  done,  choose  option  9  to  return  to  the  main  menu,  then 
option  4  (graph  results)  to  see  the  results  of  the  transform.  Answer  the 
"Time,  Magnitude,  or  Phase?"  prompt  with  an  "M"  to  sec  the  magnitude  of 
the  frequency-domain  data.  Once  the  graph  is  drawn,  choosing  option  1 
(print  screen)  gives  the  plot  of  figure  7. 

Often  it  is  desirable  to  view  the  graph  on  a  linear  scale.  To  do  this,  choose 
option  2  (change  parameters)  and  then  choose  type  1  (linear  ;t-axis,  linear 
y-axis).  When  the  graph  is  redrawn  and  printed  using  option  1  (print 
screen),  the  plot  of  figure  8  is  obtained. 

Tc  perform  an  inverse  FFT,  return  to  the  main  menu  by  selecting  option  9, 
then  return  to  the  signal  processing  menu  by  selecting  option  3.  From  the 
signal  processing  menu,  choose  option  4  (inverse  FFT).  When  the  inverse 
FFT  is  finished,  return  to  the  main  menu,  then  choose  option  4  (graph 
results),  this  time  selecting  "T"  at  the  prompt  "Time,  Magnitude,  or 
Phase?"  This  displays  the  time-domain  function  as  a  result  of  an  FFT  fol¬ 
lowed  by  an  inverse  FFT.  The  result,  when  printed,  is  figure  9. 
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Now  to  save  the  data,  choose  option  9  to  return  to  the  main  menu,  then  op¬ 
tion  2  (retrieve/save  data)  to  reach  the  file  I/O  menu.  Choose  option  1 
(save  data  to  disk)  and,  when  prompted,  save  the  wave  to  file  A: 
SINE.FFT.  When  returned  to  the  main  menu,  choose  option  9  (exit  to  sys¬ 
tem)  to  leave  the  program.  You  are  done. 
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Figure  9.  A4-MHz 
sine  wave  in  time  do¬ 
main  after  a  forward 
and  then  inverse  FFT. 
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4.  Mathematical  Theory 


1 


Each  of  the  main  mathematical  functions  of  the  program  is  discussed  in 
detail  below.  The  implementation  of  these  functions  can  be  found  in  the 
program  listings  of  the  appendix. 

4.1  Rotation 

A  digitized  waveform  is  input  with  respect  to  the  horizontal  and  vertical 
axes  of  the  oscilloscope  photograph  (oscillograph).  These  axes,  however, 
may  not  be  truly  horizontal  and  vertical  with  respect  to  the  digitizer’s 
coordinate  system  and,  in  fact,  these  axes  may  not  even  be  perpendicular 
to  each  other.  (Such  a  coordinate  system  is  called  oblique.)  It  may  be 
necessary,  therefore,  to  rotate  the  digitized  waveform  (via  software)  in  or¬ 
der  to  align  its  coordinate  system  with  the  digitizer’s  coordinate  system 
(see  fig.  10).  Procedure  Rotate_Waveform,  called  automatically  after  the 
photo  has  been  digitized,  performs  this  rotation  in  three  steps: 


I 

1 


1 


( 1 )  Calculation  of  the  "true"  origin,  {Xq,  yg). 

(2)  Conversion  of  the  oblique  coordinates  to  rectangular  com¬ 
ponents,  (a:^,  y,.). 

(3)  Calculation  of  the  scaling  factors,  x-factor  and  y-factor. 

Calculation  of  the  "true"  origin  is  necessary  since  the  x-  and  y-axes,  as  in¬ 
put,  may  not  intersect.  The  true  origin,  (Xq,  yo),  is  obtained  from  the 
formulas 


- 

X2-X1 


...  _  >'4  -ys 

ntf  = -  , 

^  X4  -X3 


Xo  = 


y2  -y3  +myX3  -mxX2 
niy  -  nix 


yo  =y2  +m,(xo  -X2)  , 
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where 


ntx  =  the  slope  of  the  digitized  x-axis, 
my  =  the  slope  of  the  digitized  ^'-axis, 

Xo  =  thex-coordinate  of  the  origin,  and 
yo  =  the  y-coordinate  of  the  origin. 

(Note  that  if  X3  =  x^,  it  is  necessary  that  Xq  =  X3.)  These  formulas  come 
from  the  equations 


y  _  y,  =  ^ — Zl  (x  -  xi )  and 
X2  -x\  ’ 

. ^3  “>’4  ..  , 


by  substituting  (Xy,  y^)  for  (x,  y). 


Figure  10.  Input 
wavefurm  before  rota¬ 
tion  (x',y')  and  after 
rotation  (x,  y). 


S 
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Conversion  of  the  input  (oblique)  coordinates  to  rectangular  coordinates  is 
accomplished  by  the  formulas 

x=x'  cos(0)  +  y '  cos(o)'  +  0)  and 
y  =.r' sin(0) +y' sin((o'  + 0)  . 

These  formulas  come  from  the  equations  (from  CRC  Standard  Math 
Tables,  1984) 


_  X '  sin(o)  ~  0)  +  y "  sin[0)  -  (to'  +  0)] 
^  “  sin  (0 


X '  sin(0)  -t-  y "  sin(o)"  +  0) 


sin  (0 


CD  =  2  and 


sin  =cosa 


Lastly,  the  digitizer  coordinates  are  scaled  to  the  true  coordinates  as  fol¬ 
lows.  The  length  of  each  axis  is  calculated: 


'•x  =  v(.r2-xo)^  +  (y2 -yo)^  , 


ry  =y{x3-X4f +{y^ -y4f  . 


The  user  then  inputs  the  total  time  and  total  amplitude  displayed  in  the 
photo.  The  scaling  factors  are  then 

x-factor  =  (total  time)/r,  , 

y-factor  =  (total  amplitude )/rj,  . 

The  "true"  coordinates  are  then  the  digitizer  coordinates  times  the  scaling 
factor. 


If  the  photo’s  coordinate  system  were  not  rotated  into  the  digitizer’s  coor¬ 
dinate  system,  a  certain  amount  of  error  would  occur.  This  error,  which 
would  depend  on  the  angle  between  the  axes  of  the  two  coordinate  sys¬ 
tems,  0,  would  be  proportional  to  cos  0. 

4.2  Interpolation 

Input  data,  whether  from  digitizer  or  disk,  may  contain  an  arbitrary  num¬ 
ber  of  data  points,  taken  at  arbitrary  time  intervals.  In  order  to  perform 
any  of  the  signal  processing  functions,  we  must  transform  this  randomly 
spaced  data  to  a  collection  of  equally  spaced  data  points  which  still  accu¬ 
rately  represent  the  original  data.  In  addition,  the  FFT  algorithm  is  a 
"power  of  2"  algorithm  which  requires  2"  input  points  (for  some  integer 
n),  so  the  arbitrary  number  of  points  in  the  input  waveform  must  be  inter¬ 
polated  into  2"  points.  This  interpolation  of  the  data  is  performed 
automatically  before  any  of  the  signal  processing  functions  are  called  the 
first  time.  Interpolation  is  accomplished  either  by  procedure  Linearlnter- 
polation,  a  modification  of  subroutine  LINT  by  Noon  (1976)  (see  bibliog¬ 
raphy),  or  by  procedure  CubicSpline,  a  modification  of  the  natural  cubic 
spline  algorithm  by  Burden  and  Faires  (1985). 

4.2.1  Linear  Interpolation 

Linear  interpolation  joins  the  set  of  data  points  {(%yo)’ 
by  a  series  of  straight  lines.  A  data  point  (.x,y)  is  then  interpolated  between 
two  given  points  by  calculating  the  equation  of  the  line  through  the  points, 
then  using  the  desired  value  of  x  to  calculate  the  corresponding  value  of  y 
(see  fig.  11).  The  equations  for  this  are 

x=Xi-\-h  , 

Y  —  f  ~y‘ 

^  v.x,+t-ac,  /  Xi+I -Xi 

The  disadvantage  of  using  linear  interpolation  is  that  at  each  of  the 
endpoints  of  the  subintervals  there  is  no  assurance  of  differentiability, 
meaning  that  the  interpolated  function  may  not  be  smooth  at  these  points. 
To  obtain  a  continuously  differentiable  (and  hence  smooth)  interpolated 
function,  a  natural  cubic  spline  can  be  applied  to  the  data. 
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Figure  11.  Linear 
interpolation  of  point 
(x,j^)  between  points 

yij- 


Xq  X,  Xj  ...  X,  X,^.,  X,+2  X„ 


4.2  J  Cubic  Spline  Interpolation 


Definition:  Given  a  set  of  data  points  {(Xo,>’q),  UjO’j),  ..., 
that  j:o  <  <  ...  <  x^,  a  natural  cubic  spline  interpolant,  S,  satisfies  the  fol¬ 

lowing  conditions: 


(1)  5  is  a  cubic  polynomial,  denoted  Sj,  on  the  subinterval  [Xj, 
for  each  y  =  0,  1,  ...,  n  -  1,  such  that  Sj  =  Oj  +  bj{x  -  xj)  +  cjx  - 
xj)^  +  djix - Xj)^  where Xj^x< Xj^^, 


(2)  S(X;  )=y,  , 


for  each  y  =0, ...,  n. 


(3)  Sj+\  (Xy+i  )  —  Sj  (Xy+i  )  , 


for  each y  =0, ....  n-2. 


(4)  Vi  ^  ^  ®®ch  y  =  0, ....  /I  -  2, 


(5)  5y+,  (xy+i )  =  Sj  (xy+i )  ,  for  each  y  =  0, ..., «  -  2, 


(6)  5"(xo)  =  5"(x„)  =  0  . 


From  the  definition,  it  is  seen  that  not  only  will  the  inter|?olated  function 
S  be  smooth,  but  so  too  will  the  first  and  second  derivatives  of  S  (Burden 
and  Faires  (1985),  pp  117-129). 


Procedure  CubicSpline  (see  algorithm  1)  first  calculates  the  coefficients 
Oj,  hj,  Cj,  dj  of  each  5^.  Next,  after  all  these  coefficients  have  been  found, 
a  data  point  is  interpolated  between  two  given  points  by  using  the  desired 


value  of  X  and  the  appropriate  Sy  to  calculate  the  correspo.iding  value  of  y 
(see  fig.  12).  The  equations  for  this  are 

x=Xj  +h  ,  where Xj  <x  < xj+i  , 

y  =aj  +bjh+Cjh^  +djh^  . 

Most  EMP  waveforms  can  be  accurately  interpolated  using  the  cubic 
spline  procedure  (for  example,  compare  fig.  13  and  14),  and  hence  this  is 
the  default  interpolation  method.  The  operator  has  the  option,  however,  of 
using  linear  interpolation  instead.  This  is  useful  since  some  waveforms, 
particularly  those  containing  sharp  discontinuities  (such  as  the  square 
wave  of  fig.  15),  may  be  much  more  accurately  interpolated  by  the  linear 
procedure  (compare  fig.  16  and  17).  Once  interpolation  has  been  per¬ 
formed,  any  of  the  data  processing  functions  may  be  called. 

4.3  Integration 

Integration  is  performed  on  the  data  {(xo./(-Xo)),  (J^i  J{x\ )), ...  ,{Xn  ,f{Xn ))} 
using  the  iterated  trapezoidal  rule,  as  given  by  Tektronix  (1985): 

>’0=0, 

where 

/€  cHa.b] , 

.  b  -a 

h  - - 

n 

Xj-a-¥  jh,  for  0<j<n,  and  j  is  an  integer. 

This  routine  has  an  error  of  0{h^). 


I 
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Algorithm  1.  Natural  To  construct  the  cubic  spline  interpolant  S  for  the  function  /,  defined  at  the  numbers 

cubic  spline  algorithm  to  <  x,  <  <  v„,  satisfying  S"(.Vo)  =  S"<,x„)  =  0: 

(Burden  and  Faires,  INPUT  n:  Xq,  x, . x,;  either  generate  a,  =  /(.x,)  for  /  =  0,  1 . n  or  input  a,  for  i  =  0. 

I . n. 

OUTPUT  £j,,  h,.  c,.  d,  for  >  =  0,  I _ n  -  1. 

{Note:  S(x)  =  Sj(.x)  =  u,  +  h^ix  -  x^)  +  c^(.x  -  x^  +  J,(x  -  Xj)^  for  Xj  <  x  <  x^ . , 

Step  1  For  i  =  0,  1 n  -  1  set  =  x, , ,  -  x,. 

Step  2  For  i  =  1,  2,  .  ,  n  -  I  set 

=  1^-  I  -<>■<'^■•1  ~  1^.] 

h,  xh, 

Step  3  Set  /q  =  1;  [Steps  3.  4.  5.  and  part  of  Step  6  solve  a  tridiagonal  linear  systern 
using  Algorithm  6.7.) 

Po  =  ^- 
--0  =  0. 

Step  4  For  i  =  1,2 . n  -  1 

set  I,  =  2(x, . ,  -  X.  -  fc,  .p, 
ft,  =  ^t,!l„ 

:,=(x,-h, 

Step  5  Set  /,  =  1 ; 

',  =  0; 
f,  =  0. 

Step  6  For  /  =  n  -  1 .  n  -  2 . 0 

set 

/),  =  (<4, . ,  -  a^y  h,  -  h^ic, .  X  +  2c,)/3; 

d,  =  (<-,.x  -t,)/(3^). 

Step7  OUTPUTtu,. /),.<>  d, /or;  =  0.  1.  .  .n-1); 

STOP 


Figure  12.  Cubic 
spline  interpolation  of 
point  (x,  /)  between 
points  land 


rigure  16.  Square 
wave  using  cubic 
spline  interpolation. 


Figure  17.  Square 
wave  using  linear 
Interpolation. 
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DifTerentiation 


Differentiation  is  accomplished  on  the  data  {(x^),  /(Xq)),  (Xj,  /U,)), 

via  the  three  point  formulas,  as  given  in  Burden  and  Faircs 
(1985,  pp  137-145).  These  formulas  are 


X  fixi+h)-f{Xj  -h) 

J  2/, 


r ^  _  -3/(-Vo )  +  4/(.vo  +  )  -  f{xo  +  2h ) 

J  (vo )  -  2h 


_  fi-^n  -2h)-  4f{x„  -fi)  +  3/(.r„ ) 
J  KXn}-  2h 


where  h  and  Xj  are  as  defined  above  for  the  integration  rule.  This  routine 
also  has  an  error  of  0{h‘'). 


4.5  Fast  Fourier  Transform 

Much  of  the  discussion  of  windows  in  this  section  closely  follows  the 
work  of  Shreve  (unpublished). 

The  FFT  is  performed  by  a  modification  of  the  Cooley-Tukey  algorithm, 
as  given  in  Burden  and  Faires  (1985,  pp  398-406)  (see  algorithm  2).  Note 
that  the  FFT  operates  on  a  finite  interval  of  data,  treating  the  data  as  if  they 
were  periodic.  It  is  therefore  necessary  that  the  beginning  of  the  wave- 
fomi  be  continuous  with  the  end  of  the  waveform;  in  other  words,  the  data 
should 

( 1 )  start  and  end  at  0  (or  some  other  constant),  and 

(2)  approach  this  value  at  the  endpoints  of  the  waveform  asymptotically, 
so  as  to  avoid  introducing  discontinuities. 

While  the  algorithm  will  still  function  if  these  two  conditions  are  not  met, 
the  results  may  not  be  as  accurate. 

As  suggested  by  Shreve  (unpublished),  if  a  waveform  on  an  interval  T  is 
nonzero  at  one  or  both  of  the  endpoints,  it  may  be  forced  to  zero  through 
the  use  of  a  window.  (While  any  windowing  function  will  introduce  dis¬ 
tortion  into  the  transform,  this  distortion  is  often  less  than  the  distortion  in¬ 
troduced  by  a  discontinuity  in  the  waveform,  such  as  will  occur  if  the 
above  two  conditions  are  not  satisfied.)  Two  types  of  windows  may  be 
applied:  a  Hanning  window  or  a  rear  window.  If  neither  end  of  the  data  is 
zero,  then  a  Hanning  (or  cosine)  window  will  apply  the  function 

m  =  j  [l-cos(^)]  ,  0<t<T  , 

to  the  waveform.  This  function  is  zero  at  both  endpoints,  and  will  force 
the  waveform  to  follow.  If  the  data  at  the  beginning  of  the  sampled 
waveform  are  equal  to  zero  but  the  data  at  the  end  are  not,  then  a  rear  win¬ 
dow  will  apply  the  function 

m  =  j  {l-cos[5^^f^]}  ,  0<t<T  , 
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to  the  waveform.  This  is  the  last  half  of  the  Hanning  window  applied  over 
the  whole  interval  of  the  waveform.  It  is  up  to  the  user  to  choose  the  cor¬ 
rect  window  for  the  data. 

"Both  [the  Hanning  and  Rear]  windows  introduce  distortion  into  the  trans¬ 
form,  but  often  this  distortion  is  far  less  objectionable  than  the  ‘distortion’ 
introduced  by  the  discontinuities"  (Shreve,  unpublished).  Effectively,  the 
windows  convolve  a  pair  of  functions  with  the  transform.  These  functions 
are  half-amplitude  sin(x)/x  functions  with  the  rear  window,  and  half¬ 
amplitude  single  sidebands  with  the  Hanning  window. 

4.6  Remove  Mean 

The  mean  of  the  time-domain  waveform  may  be  removed  from  the 
waveform.  The  mean  is  calculated  as  the  sum  of  the  magnitudes  divided 
by  the  number  of  points: 


n 

1  y 

mean  =  -  , 

"  /=1 


Then 


-  mean ,  for  0  ^  ^  n 
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A-1.  Why  Pascal  ^ 

Why  Pascal?  A  common  question.  Pascal  is  often  referred  to  as  a  non- 
scientific  language,  not  for  use  in  "real"  scientific  programming.  Why, 
then,  do  1  choose  to  use  it  for  FFT?  The  primary  reasons  are 

(1)  the  speed  of  compilation  of  the  Turbo  Pascal  compiler  (up  to  27,(XX) 
lines  per  minute); 

(2)  the  speed  of  execution  of  the  resulting  programs; 

(3)  the  strong  type-checking  of  Pascal,  which  eliminates  many  of  the  in¬ 
sidious  errors  that  so  often  plague  FORTAN  and  BASIC  programs; 

(4)  the  advanced  data  structures  that  are  found  in  Pascal  which  are  not 
found  in  FORTRAN  and  BASIC,  and  which  make  programming  im¬ 
mensely  easier  and  more  logical; 

(5)  the  readability  and  the  ease  of  debugging  of  the  resulting  code,  com¬ 
pared  to  FORTRAN  or  BASIC;  and 

(6)  the  simple  elegance  of  Pascal  versus  FORTRAN  or  BASIC. 

While  some  may  say  that  the  advantages  of  Pascal  are  purely  "cosmetic" 
compared  to  the  advantage  of  the  huge  libraries  available  to  FORTRAN 
programmers,  I  have  found  that  my  productivity  has  improved  since  start¬ 
ing  to  use  Pascal  last  year,  since  less  time  is  spent  waiting  for  the  compiler 
to  do  its  job,  and  less  time  is  wasted  on  stupid  errors. 

A-2.  Availability  of  Program 

Anyone  possessing  Turbo  Pascal  4.0  and  who  has  the  necessary  hardware 
(see  table  A-1)  should  be  able  to  type  in  program  FFT,  then  compile  and 
run  it,  but  typing  3000  lines  of  code  can  be,  to  say  the  least,  a  tedious  task. 

Therefore,  a  limited  number  of  copies  can  be  made  available  to  interested 
readers  who  contact  the  author  at  the  number  given  on  p  1  of  this  report. 
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A-3.1 


File  FFT  contains  the  main  calling  routines  for  program  FFT.  All  support¬ 
ing  files  are  loaded,  the  system  is  initialized,  and  control  is  passed  to  vari¬ 
ous  procedures,  as  selected  by  the  user  from  the  main  menu.  The  file  is 
structured  as  follows: 


1.  Comments. 


2.  Include  separate  units. 


3.  Main  program 

a.  Initialize  system 

b.  Repeat 


( 1 )  Option  1 : 

(2)  Option  2: 

(3)  Option  3: 

(4)  Option  4: 

(5)  Option  5: 

(6)  Option  6: 

(7)  Option  9: 


Digitize  Data 
Disk  File  Operations 
Data  Analysis 
Graph  Results 
Advanced  Options 
Create  Waveform 
Finished 


until  finished 


c.  End  of  program 
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( . . . . . . . . . . ) 

(.  «) 

(•  Program  written  by  Jeff  Falter.  SLCSD-NW-ES.  “) 

(»  *) 

(  . . . . . . . . .  ) 

(«  .) 

(■  To  change  the  number  of  points  which  may  be  operated  upon,  the  following  *) 
(*  constant(s)  must  be  changed  In  file  Global:  *) 

(*  1.  TNArraySlze  :  the  maximum  number  of  Input  points  allowed.  *) 

(.  «) 

( . . . . . . .  ) 


Program  FFT; 

uses 

Crt, 

Graph , 

Global, 

DlgltlzeWavef  orm , 
FlleSystem, 
Signalprocessing , 
Gr aphWavef orm , 
AdvancedOpts , 

Cr eateWavef orm ; 


. . . 

begin  (FFT) 

(»••  First  Initialize  variables.  »••) 

GraphlcsCard;  ^^Oetect ; 

DetectGr aph  ( GraphlcsCard , Gr aphlcsNode ) ; 

Read_bef aultOptlons ; 

TextColor  (ForeColor); 

TextBackground  (BackColor); 

ClrScr; 

Initial lze_Tarlables; 

(«»>  Create  windows,  show  menu,  ask  choice.  »••••) 
repeat 

HalnNenu; 

case  NalnCholce  of  (*  Choices:  * ) 

1:  begin  (create)  (>  1.  Data  from  digitizer  *) 

If  (SerlalPort  <>  0)  then  begin 

PrlntText  (’Digitize  time  or  frequency  data  (T/F)7  ’, 
StartColumn-1 ,23 ) ; 

repeat 

NalnChar : =UpCase( ReadKey ) ; 
until  (NalnChar  In  [’T’ , ’F’ , ENTER] ); 

If  (NalnChar  ENTER) 
then  Digitizer  ( ’T’ ) 
else  Digitizer  (NalnChar): 
end;  ( If) 
end;  (create) 

2:  FllelO;  (•  2.  File  operations.  *) 

3:  If  ORIG  OR  TRANS  then  begin 
If  NOT  ACCEPT  then 

PrlntText  (’Interpolation  In  progress.  Please  wait  —  ', 
StartColumn-1 ,23 ) ; 

SPS;  (*3.  Signal  Processing.  " ) 

end; 
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4:  begin  (graph)  (*  4.  Graph  data.  >) 

If  TRANS 

then  begin 

PrlntText  (‘Tine.  Magnitude  or  Phase  (T/M/P)?’, 
StartColumn-1 ,23 ) ; 

repeat 

MainChar : sUpCaaeC  ReadKey ) ; 
until  (MainChar  In  [*T' , ’M* , *P’ .ENTER] ); 

If  (MainChar  =  ENTER) 
then  if  ORIG 

then  GraphResults  ( ’T* ) 
else  GraphResults  ( *M* ) 
else  GraphResults  (MainChar); 
end  ( then) 

else  If  ORIG  then  GraphResults  (’T*); 
end;  (graph) 

8;  AdvancedOptions;  (*5.  Advanced  Options  ») 

6 :  begin 

AnalyticWavefora;  (»  6.  Create  Analytic  Waveform.  «) 

If  ORIG  then  begin 
GraphResults  ( 'T* ); 
end;  (If) 
end; 

9:  begin  (finished)  (»  9.  Exit  program.  •) 

DONE!=true; 

ClrScr; 

Release  (HeapTop); 
end;  ( finished) 
end;  (case) 
until  DONE; 
end.  (FFT) 
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A-3.2  GlobalProcedures 

Unit  GlobalProcedures  contains  all  constant,  type,  and  variable  declara¬ 
tions,  as  well  as  routines  that  are  used  in  the  main  program  and  in  several 
of  the  supporting  procedures.  The  routines  are 

1 .  InidalizeVariables— initializes  pointer  and  Boolean  variables 

2.  PrintText— prints  a  string  at  a  specified  location  on  the  screen. 

3.  ClearWindow-erases  a  part  of  the  screen. 

4.  PrintScreen-prints  the  current  screen  image. 

5.  Buzzer— sounds  a  warning  buzzer. 

6.  MainMenu— prints  the  main  menu  choices  in  the  center  of  the  screen. 

7.  String_to_Value-converts  a  string  containing  numbers,  multipliers, 
and  units  to  a  numeric  value. 

8.  EXIST-determines  if  a  specified  file  exists. 

9.  PrintErrorMsg-prints  a  message  in  a  box  at  a  specified  location  on  the 
screen.  The  routine  may  optionally  wait  for  a  user  input  before  returning 
control  to  the  calling  routine. 


» 


5 

I 
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( ««»  These  constant,  types,  variables  and  procedures  are  ones  used 
(*«»  throughout  the  program. 


unit  Global; 

interface 

uses 

DOS, 

Printer, 

Crt, 

Graph; 

const 

VerslonNumber  =  3.00; 

TNNearlyZero  =  le-15; 

TNArraySlze  =  2048; 

type 

real  =  extended; 

TNVectorArray  =  array  [0. .TNArraySlze]  of  real; 
TNVectorPtr  =  ''TNVectorArray ; 


TNVectorPtr;  (*•  time  axis  Information 

TNVectorPtr;  ("  amplitude  of  time  domain  data 

”  'ectorPtr;  (*  frequency  axis  Information 

TNVectorPtr;  (•  magnitude  of  freq  domain  data 

TNVectorPtr;  (•  phase  of  frequency  domain  data 


const 

Maxinfo  =18;  (» 
PI  =  3.141592979431182;  (• 
blank  =  *  ’;  (» 
precision  =12;  (» 
ENTER  =  #13;  (• 
StartColumn  =20;  ( * 
MlnP  !  byte  =9;  (» 
SerlalPort  :  byte  =  1 ;  ( * 
NoPr Inter  :  boolean  =  true:  { * 
SPLINE  :  boolean  =  true;  (* 
ForeColor  :  byte  =  LlgbtGreen; 
BackColor  :  byte  =  Blue;  ( * 
DrawColor  :  byte  =7;  ( •• 
DefaultOptlons  =  'FFT.cfg';  (« 
DefaultDataDlr  :  8trlng[79]  =  ’c:’; 


Max  num  of  Information  lines  In  file 

The  constant  PI,  In  double  precision 

Blank  string  for  Info 

Precision  of  output  file 

ASCII  code  of  RETurn  key 

Left  edge  of  menus 

Nln  power  of  2  to  Interpolate  to 

Comm,  port  for  digitizer. 

Printer  connected  to  computer? 

Cubic  Spline  or  Linear  Interp.? 

( "  Foreground  color  on  color  monitor 
Backgroxmd  color  on  color  monitor 
Drawing  color  for  color  monitors 
File  for  default  options 

(•  Default  data  dlsk/dlrectory 


type 

GraphName 

InfoArray 

PlotType 


string;  (• 

array  [1.. Maxinfo]  of  string; 
1..4:  (• 

(' 

(' 
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Descriptors  for  printing  »  ) 
(•  Desrlptlve  Info  In  file  ») 
Type  of  plot:  * ) 

1.  Linear  »  ) 

2.  Log  •) 

3.  Log-Linear  » ) 

4 .  Linear-Log  » ) 


NumPolnts 


Integer ; 


(•  Number  of  points  read. 
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NumFreqs  : 

integer; 

(.  Number  of  distinct  frequencies. 

•) 

TRANS  : 

boolean; 

( •  Data  Translated? 

“) 

ORIG  : 

boolean; 

(*  Original  Data? 

•) 

DONE  : 

boolean; 

(*  Exit  program? 

•) 

ACCEPT  : 

boolean; 

(»  Interpolated  data  acceptable? 

•) 

HeapTop  : 

''integer ; 

(<•  Marks  top  of  dynamic  memory. 

*) 

TempXPtr  : 

TNTectorPtr ; 

(»  Temporary  pointer  to  TNVector. 

•*) 

TempYPtr  : 

TNTectorPtr; 

(.  Temporary  pointer  to  TNVector. 

») 

OutArrayX  : 

TNVectorPtr ; 

(“  Temporary  output  ptr  to  TNVector. 

») 

OutArrayY  : 

TNTectorPtr; 

(.  Temporary  output  ptr  to  TNVector. 

«) 

MalnCholce  : 

byte; 

(«  Main  Menu  choice 

•) 

Choice  : 

char; 

(.  temporary  variable 

») 

MalnChar  : 

char; 

(»  Type  of  plot  (T/M/P)? 

*) 

GraphlcsCard 

:  integer ; 

(*  ‘fnx  of  graphics  card  Installed 

») 

GraphlcsMode 

:  Integer; 

( »  Graphics  mode  to  be  used 

«) 

XMaxTemp  : 

Integer ; 

(*  Used  in  window  definitions 

•) 

YHaxTemp  : 

integer ; 

(•  Used  in  window  definitions 

») 

leftx  : 

integer ; 

( »  Left  edge  of  window  boundary 

») 

rlghtx  : 

Integer; 

( <•  Right  e4ge  of  window  boundary 

•) 

topy  : 

Integer ; 

(.  Top  edge  of  window  boundary 

«) 

bottomy  : 

Integer ; 

(•>  Bottom  edge  of  window  boimdary 

«) 

i  : 

integer ; 

(.  Counter  variable. 

*) 

info  : 

InfoArray; 

(•  Array  of  information  stored  at 

•) 

(.  end  of  data  files. 

«) 

. . . . - . . . ........) 


procedure  Inltlalize^Tarlables; 


(  — . . . . . . . . 

(..» 

(.»»  PrlntText  prints  a  string  of  text,  starting  at  text  coordinates  «»«) 

(xcoor.ycoor )i  where  (1,1)  is  the  iipper  left  corner  and  (80,25)  is  »»«) 
(.»»  the  lower  right  corner.  ...) 

(.».  »..) 

. . - . . . . . ) 

procedure  PrlntText  (  str  :  string;  ( "  Text  to  be  printed  •  ) 

xcoor  :  byte;  (»  column  to  start  printing  * ) 

ycoor  :  byte  ( »  row  to  start  printing  • ) 

); 

(  . . . . . . . . . . ) 

(...  ...) 

(...  ClearWlndow  is  to  clear  a  portion  of  the  screen,  from  text  *•••) 

(...  coordinates  (XMin,YNln)  in  the  upper  left,  to  (XMax,YNax)  in  the  ...) 

( •».  lover  right.  ...) 

(»«•  ...) 

(  . . . . . . . . . . . . ) 

procedure  ClearWlndow  (  XMln  ;  byte;  (*  first  column  to  be  erased  *) 

XMax  :  byte;  (*  last  column  to  be  erased  <■ ) 

YMin  :  byte;  (•  first  row  to  be  erased  ») 

YHax  :  byte  ( •  last  row  to  be  e*-c8ed  « ) 

); 


. . . . .......) 

( ...  ...^ 
(...  Print_Screen  procedure  prints  the  current  screen  by  executing  the  »..) 
(...  keyboard  command  "Shlft-PrlntScreen" .  Note  that  the  DOS  program  ••••) 
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(»••••  GRAPHICS.COM  must  be  executed  before  this  routine  will  work;  this  •"*■•) 
(■***  Is  done  In  the  Initialization  section.  »•••) 

(«»»  •••) 

. . . . . . . . 

procedure  Prlnt_Screen: 

( . . . . . . ) 

(...  ...) 

(...  Procedure  Buzzer  sounds  a  warning  buzzer  when  an  Incorrect  response  ..*) 
(...  iB  given  by  the  user.  *••*) 

(K«.  ..») 

(  . . . . . . . . ) 

procedure  Buzzer; 

. . . . . . . . . * . 

(...  ...) 

(...  NalnMenu  display  the  main  system  menu  at  the  center  of  the  screen.  ...) 

(xm  ...) 

. . . . . . . 

procedure  MalnMenu; 

. . . . . .) 

(...  ...) 

(...  Strlng_to_Valuo  converts  a  string  to  a  numeric  value  with  a  •»») 

(...  multiplier  and  units.  *•"*) 

(...  »..) 

(-«« . . . . . 

procedure  Strlng_to_Talue  (  st  :  string: 

TAR  value  :  real: 

TAR  units  :  string 

); 

( . . . . . . . . . . . ) 

(...  ...) 

(...  Function  EXIST  determines  If  the  specified  filename  already  exists.  .*.) 

(...  ...) 

(•••• . . . . ) 

function  EXIST  (filename  :  string)  :  boolean; 

. . . . . ...) 

(...  ...) 

(...  PrlntErrorMsg  prints  the  string  s  starting  at  text  coordinates  ...) 

(...  (x,y).  The  message  Is  surrounded  by  an  error  box.  If  wait  Is  true,  ...) 

(...  then  a  char  response  ,resp,  may  be  read  before  returning  control  ...) 

(...  to  tbe  calling  procedure.  ...) 

(...  ...) 

( . . . . . . . 

procedure  PrlntErrorMsg  (  s  ;  string; 

X  ;  byte; 
y  ;  byte; 
wait  :  boolean; 

TAR  resp  :  char 
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): 


. 

. . . 

Implementation 


) 

) 


procedure  Initlallze_TarlableB; 

begin  { Initlalize_Variablea) 
DONE  :=falBe: 

TRANS  :=falBe; 

ORIG  :=falBe; 

ACCEPT  :=falBe; 

Mark  (HeapTop); 
new  (time); 
new  (ampl); 
new  (freq); 
new  (mag): 
new  (phase): 
new  (TempXPtr); 
new  (TempYPtr); 
new  (OutArrayX); 
new  (OutArrayY); 

FillChar  (lnfo,Slze0f(info),0); 
end;  ( Inltialize_Varlables) 


procedure  PrlntText  (  str 

xcoor 

ycoor 

): 

begin  { PrlntText ) 

GotoXY  ( xcoor , ycoor ); 
write  (str): 
end;  (PrlntText) 


procedure  ClearWindow  (  XMln  :  byte; 

XMax  :  byte; 
YNin  :  byte; 
YMax  :  byte 

); 

var 

CurrNlnX  :  byte; 

CurrMinY  :  byte; 

CurrMaxX  :  byte; 

CurrMaxY  :  byte; 


( »  Text  to  be  printed  •• ) 
(•  column  to  start  printing  '‘) 
( »  row  to  start  printing  « ) 


(« 

first 

column 

to 

be 

erased 

«) 

(• 

last 

column 

to 

be 

erased 

’•) 

(* 

first 

row 

to 

be 

erased 

«) 

(• 

last 

row 

to 

be 

erased 

») 

:  string; 
:  byte; 

:  byte 


begin  ( ClearWindow) 

CurrHinX : =Lo( WindNln ) ; 

CurrMinY : =H1 ( WindMln ) ; 

CurrMaxX : =Lo( WindMax ) ; 

CurrMaxY : =H1 ( WindMax ) ; 

Window  ( XMln, YMin, XMax, YMax); 

ClrScr ; 

Window  ( Cur rMinX , CurrMinY , CurrMaxX , CurrMaxY ) ; 
end;  (ClearWindow) 


procedure  Prlnt_Screen; 

const  FormFeed  =  #12;  (*  formfeed  for  an  Epson-compatible  printer  «) 

var 

Reg  :  Registers:  (*  variable  to  read/%(rlte  to  the  8088  registers  ») 

begin  {Prlnt_Screen} 

If  NOT  NoPrlnter  then  begin 
Intr  ($5, Reg); 
wrlteln  (1st, FormFeed); 
end;  (If) 
end ;  ( Pr IntScr een ) 


procedure  Buzzer; 
const 

pitch  =  440;  (*  pitch  of  warning  sound  *) 

PauseLength  =  260:  (*  length  of  warning  sound.  In  ms  *) 

LongPauseLength  =  1000;  (*  additional  time  to  display  error  msg  ■* ) 

begin  ( Buzzer } 

Sound  (pitch); 

Delay  (PauseLength); 

NoSound; 

Delay  (LongPauseLength); 
end;  (Buzzer) 


procedure  MalnMenu; 
var 

Choice  :  char; 
begin  (MalnMenu) 

If  GraphlcsCard  =  HercMono  then  begin 
TextColor  (ForeColor); 

TextBackground  ( BackColor ) ; 
end;  ( If) 

ClrScr ; 

Window  (StartColuiim-l,2,80,2S); 

GotoXY  (8,1);  write  (’MalnMenu  ( ’ ,Ver8lonNumber:4:2, ’ ) ’ ) ; 
PrlntText  (’Select  Option  by  typing  a  number: ’ ,1,3); 
PrlntText  (’1.  Digitizer  ’,9,6); 

PrlntText  (’2.  Retrieve/Save  Data  ’,9,8); 

PrlntText  (’3.  Signal  Processing  ’,9,10); 

PrlntText  (’4.  Graph  Results  ’,9,12); 

PrlntText  (’8.  Advanced  Options  ’,9,14); 

PrlntText  (’6.  Create  Waveform  ’,9,16); 

PrlntText  (’9.  Exit  to  System  ’,9,18); 

PrlntText  (’Your  Choice?  ’,1,22); 

GotoXY  (14,22); 
repeat 

Choice : =ReadKey ; 

until  (Choice  In  . ’6’ , ’9’]  ); 

MalnCholce:=ord( Choice )-ord( *0’ ); 
write  ( HalnCholce ) ; 

Window  (1,1,80,28); 
end;  (MalnMenu) 


procedure  Strlng_to_Value  (  st  :  string; 
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VAR  value 
VAR  units 


real; 

atrinjt 


); 


coast  blank 


J  :  integer: 

code  :  integer; 

i  :  0..1; 

factor  :  real; 


begin  { String_to_Value} 

if  Bt[l]  =  ’.*  then  8t!=*0’+8t; 
Val  (at, value. code); 
if  code  <>  0 
then  begin 
i!=0; 

case  St [code]  of 

•p':  factor :°le-12: 


(• 


•n*: 

•u’l 


(' 


(' 


(• 


•k* 
•M* 
•G* 
•  • 


(' 


(• 


(• 


(' 


pico 

nano 

micro 

mill! 

kilo 

Mega 

Giga 

Tera 


end; 


factor : =le-09 ; 
factor :=le-06; 
factor :=le-03; 
factor :=le+03: 
factor :=le+06; 
factor : =le+09 ; 
factor :=le+12: 
else  begin 

factor : =1 . 0 ; 
unitsCl] :=st[code] ; 
i:=l: 

end;  (else) 
end;  { case) 

Delete  (st.code.l); 

Val  ( St .value, code); 
if  code  <>  0 
then  begin 

for  3i=l  to  length( St )-code+l  do 
units  [J+i]:=8tij+codo-l]; 
Delete  ( at , code , length( st )-code+l ) ; 
Val  ( St, value, code); 
end  ( then) 
else  units :=blank; 
value ; =value*factor ; 
end  (then) 
else  unlt8:=blank; 

{ Strlng^to_Value) 


E 


function  EXIST  (filename  :  string)  :  boolean: 
var 


OK  :  boolean; 
Name  :  text; 


( »  temporary  variable,  equal  to  exist  • ) 


begin  (EXIST) 

if  length  (filename)  >  0 
then  begin 

Assign  (Name, filename); 
($1-)  Reset  (Name);  ($1+) 
0K:-(I0result=0); 
exist :sOK; 

if  OK  then  Close  (Name); 
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end  { then} 
else  EXIST: -false; 

end;  (EXIST) 


procedure  PrintErrorNsg  (  s  :  string; 

X  :  byte; 
y  :  byte; 
wait  :  boolean; 
TAR  reap  :  char 
): 


procedure  DrawBorder  (xl,yl,x2,y2  :  byte); 


const 

TopLeft  = 
BottomLeft  = 
TopRlght  - 
BottomRlght  = 
Vertical  - 
Horizontal  = 


{char(201)} 
{ char( 200 ) ) 
{char{187)} 
{char(  188)) 
{char(186)} 
{ char(205)} 


begin  ( DrawBorder ) 

GotoXY  (xl.yl);  write  (TopLeft); 
GotoXY  (xl,y2);  write  (BottomLeft); 
for  l:=xltl  to  x2-l  do  begin 

GotoXY  (l.yl);  write  (Horizontal); 
GotoXY  (i,y2);  write  (Horizontal): 
end;  (for) 

GotoXY  (x2,yl);  write  (TopRlght); 
GotoXY  (x2,y2):  write  (BottomRlght); 
for  l:-yl+l  to  y2-l  do  begin 

GotoXY  (xl,l);  write  (Vertical); 
GotoXY  (x2,l);  write  (Vertical); 
end;  (for) 
end ;  ( DrawBorder ) 


const 

PauseLength  -  1000; 


var 

CurrNinX  :  byte; 

CurrHlnY  :  byte; 

CurrMaxX  :  byte; 

CurrMaxY  :  byte; 

MaxLength  :  byte; 

BorderLength  :  byte; 

begin  ( PrlntErrorMsg) 

CurrHlnX;=succ(Lo(WlndNln) ); 

CurrHinY;-succ(Hi(WlndNln) ); 

CurrMaxX : -succ( Lo( WlndNax ) ) ; 

CurrMaxY : -succ( Hi ( WlndMax ) ) ; 

MaxLength:  -CurrMlnX+x-f  length!  s  )+2; 
if  wait  then  MaxLength :-succ( MaxLength); 

BorderLength: =MaxLength-CurrMlnX+2; 

Window  ( CurrMlnX+x-2 , CurrMlnY+y-l .MaxLength , CurrMlnY+y+1 ) ; 
TextColor  (White); 

TextBackground  (Red); 

ClrScr ; 

DrawBorder  ( 1,1 , length!  s  )-f4,3); 

PrintText  (s,3,2); 

Buzzer ; 


•' 

r 

I, 
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if  not  wait 

then  Delay  (PauseLensth) 
else  re8p:=ReadKey; 

TextColor  (ForeColor); 

TextBackground  (BackColor); 

ClrScr; 

Window  ( CurrNlnX , CurrMlnY , CurrMaxX , CurrMaxY ) ; 
end;  ( PrlntErrorNsg) 

(*•"•««« . . . . . . 

begin  { Initialization) 

Exec  ( *  \Coiiiinand.com’ ,  */c  graphics’); 
end.  ( Initialization) 
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A-3.3  SignalProcessing 

Unit  SignalProcessing  performs  two  functions:  it  creates  the  signal  proc¬ 
essing  menu  and  it  provides  access  to  the  data  analysis  functions.  It  oper¬ 
ates  as  follows: 

1 .  If  necessary,  interpolate  data 

2.  Display  menu 

3.  User  chooses 

a.  Option  1:  Integrate 

b.  Option  2:  Differentiate 

c.  Option  3:  FFT 

d.  Option  4:  Inverse  FFT 

e.  Option  5:  Transfer  Function 

f.  Option  6:  Remove  Mean 

g.  Option  9:  Finished 

4.  Repeat  until  finished 

This  file  also  contains  all  the  signal  processing  routines,  each  of  which  is 
described  below. 

Fitting-contains  two  different  fitting  routines:  a  linear  and  a  cubic  spline 
fitting  routine.  The  cubic  spline  routine  is  used  by  default,  but  the  user 
may  select  to  use  linear  interpolation  from  the  advanced  options  menu  of 
the  main  program.  Procedure  Fitting  also  determines  the  number  of  points 
to  which  to  interpolate  the  data;  this  value  is  2”  for  some  integer  n. 

Integrate-performs  a  numerical  integration  using  the  trapezoidal  rule. 

Differentiate-performs  a  numerical  differentiation  using  the  three  point 
fomiulas. 

TransferFunction-adds,  subtracts,  multiplies,  or  divides  either  axis  of  the 
time-domain  data  (time  or  amplitude)  by  a  constant. 

RemoveMean-removes  the  mean  of  the  time-domain  waveform. 
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MyFFT-contains  the  actual  FFT/IFT  routines.  These  routines  were  devel¬ 
oped  from  the  FFT  algorithm  given  in  Burden  and  Faires,  Trigonometric 
Polynomial  Interpolation  (see  bibliography,  main  body  of  report).  The 
following  routines  are  contained  in  this  procedure: 

1 .  Timer-gets  the  current  time  from  DOS,  returns  the  time  in  seconds. 

2.  Cooley _Tukey_FFT— the  FFT  routine  itself. 

3.  PolarForm-converts  real/imaginary  results  to  magnitude/phase  results. 

If  the  user  desires  it,  the  procedure  applies  a  window  to  the  waveform  be¬ 
fore  performing  the  FFT.  Temporary  variable  reassignments  are  then  per¬ 
formed,  the  Cooley-Tukey  FFT  routine  is  called,  the  results  are  put  in 
polar  form,  and  the  temporary  variables  are  reassigned  to  the  correct  main 
variables. 

After  each  of  the  routines  is  finished,  control  is  returned  to  the  SPS  menu. 
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unit  Signalprocessing; 

Interface 

uses  DOS, 

Crt, 

Global; 


( . . . . . . . ) 

(...  ...) 

(...  Integrate  performs  numerical  integration  on  the  time  domain  data  ...) 
(...  via  the  trapezoidal  rule.  Note  that  this  procedure  requires  ...) 

(...  approximately  2»m  additions  and  2»m  multiplications.  ...) 

{...  ...) 

(«*•«**• . . . . . . . ) 


procedure  Integrate; 


(......... . . . . . . . . . ) 

(...  ...) 

(...  Differentiate  performs  numerical  differentiation  via  the  so-called  ...) 
(...  three  point  formulae.  The  routine  requires  approximately  2*m  ...) 

( ...  additions  and  2«m  multiplications.  ...) 

(...  ...) 

( . * . . . . . . . . . ) 


procedure  differentiate; 


( . . . . . * . . . . . ) 

(... 

(...  TransferFunctlon. scales  either  the  x-  or  y-axls  by  a  constant.  The  .».) 
(...  first  character  read  will  decide  upon  which  oxls  to  act,  ond  the  •••) 
{...  next  character  read  will  decide  the  operation  to  be  performed.  Only  »»») 
(...  the  characters  end  ore  accepted  for  operations.  ...) 

(.*»  ...) 

( . . . * . . . ) 


procedure  TransferFunctlon; 


{ . * . . . . . . . ) 

(.  .) 

(•  RemoveMean  calculates  the  meon  of  the  time  domain  data  and  subtracts  ») 
(*•  that  value  from  the  entire  array.  •) 

(.  «) 

( . . . . . * . ........) 


procedure  RemoveMean; 


(««*♦*** . . . . . * . * . . . . . ) 

(...  ...) 

(...  Transform  performs  a  forward  or  inverse  fast  Fourier  transform,  ...) 

(...  based  on  the  Cooley-Tukey  method.  Cooley_TuKey_FFT  is  modified  ...) 

(...  from  the  FFT  algorithm  of  Numerical  Analysis.  3rd  ed.  by  Burden  i  .».) 
(...  Faires,  p.  404.  The  algorithm  Is  based  on  the  Cooley-Tukey  FFT  ...) 

(...  algorithm.  ...) 

^...  ...j 

( . * . * . . . •••) 


procedure  Transform  ( INVERSE : boolean  ) ; 
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^  ««« 


(• 


SPS  prints  the  SPS  menu,  and  gives  the  user  the  choice  of  one  of 
several  signal  processing  functlns: 


***  ^ 
***  ^ 


(• 


^ »»« 
^  •«« 
^  «»»• 
( *** 
( *## 
^ ««» 
^ »»» 
( *** 
^ ««» 


1 . 
2. 

3. 

4. 

5. 

6. 


Integration  of  time  domain  data. 

Differentiation  of  time  domain  dota. 

Fast  Fourier  Tronsform  of  time  domain  dota. 

Adjust  (4-, -,*,/)  time  domain  amplitude  by  a  constant. 
Multiply  time  base  by  a  factor. 

Subtract  the  mean  of  the  time  domain  waveform. 


»««  j 
**»  j 


**#  j 
«««  j 


SPS  is  called  AFTER  the  data  has  been  fitted,  a  procedure  invoked 
the  first  time  one  chooses  selection  3  from  the  Main  Menu. 


««« ^ 


»«» j 
»»» j 


(• 


procedure  SPS; 


implementation 


(• 


(  ««« 
^  »»« 
(  *** 
^  *** 
(  *** 


(• 


Fitting  accepts  for  Input  on  array  of  NumPolnts  arbitrarily  spaced 
data  paints,  and  returns  as  output  an  array  of  2''n  evenly  spaced 
data  paints.  The  method  of  Interpolation  used  is  either  linear 
interpolation  or  natural  cubic  spline  Interpolation. 


«««  ^ 


(• 


procedure  Fitting; 


const 


ISC 

Pow2  :  array  [5.. 12]  of  integer  =  (32,64,128,256,512,1024,2048,4096); 


NewNumPolnts 

i 

J 

XI 

X 

Increment 


integer 
Integer 
integer 
real 
reel 
real 


Number  of  points  to  interpolate  to. 
Counter  variable. 

Counter  for  NewNumPoints . 

First  X  value. 

Frequencies  of  fitted  data. 

Distance  between  successive  x-coor. 


Linear  performs  linear  interpolation  on  the  time  domain  data. 


procedure  Linear; 


var 

m 

b 

denom 

j 

begin  (Linear) 
i:>0; 

XI  :  >time''[0] 
TempXPtr^[0] 
TempYPtr~[0] 


real; 
real ; 
real  ; 
integer; 


Slope  of  interpolation  line. 
Y-intercept  of  interpolation  line. 
Difference  between  succeslve  points. 


=time”[0]  ; 
ampl”[0]  ; 


increment: =( time* [NumPolnts- 1 ] -time" [0] )/(NewNumPoints-1 ) ; 
for  J:=1  to  NewNumPoints- 1  do  begin 
X  :  -X1+J ♦increment ; 
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while  X  >  tlme~[l]  do  l:>succ(l): 

(»•»  Calculate  slope  and  y-lntercept  •*») 
denom:  -time*[l]-tiine“[l-1] ; 
m:  =(ampl'‘[i]-ampl“[l-l]  )/denom; 

b:  -  (ampl*[i-l  ]*tlme''[l]-atnpl~[i]*time~[i-1  ]  )/ denom; 
TompXPtr''[j]  :  -x; 

TempYPtr''[j ]  :  =m*x+b ; 
end;  {for} 
end;  {Linear} 


««»* 

»»* 

«»«•  ^ 

CubicSpline  performs  a  Cubic  Spline  interpolation  on  the 

time 

««»  ^ 

domain 

data.  The  algorithm 

used  is  a  modification  of  the 

algorithm 

»»» 

3,4  of 

Numerical  Analysis, 

3rd  ed.  by  Burden  &  Faires,  p. 

122. 

»»»  ^ 

»»» 

«»»« 

procedure  CubicSpline; 


vor 

temp 

real ; 

(“ 

A  temporary  real  variable. 

♦} 

b 

TNVectorPtr 

(• 

First  spline  coefficient. 

*) 

c 

TNVectorPtr 

{• 

Second  spline  coefficient. 

*) 

d 

TNVectorPtr 

(* 

Third  spline  coefficient. 

*) 

h 

TNVectorPtr 

{« 

Dlst.  between  successive  data  pts . 

•) 

1 

Integer; 

J 

Integer; 

begin 

{CubicSpline} 

new 

(b);  new  (c);  new  (d); 

new 

(h); 

(•*»  Calculate  spline  coefficients  •*») 

for  i : *0  to  NumPolnts-2  do  h"[i] : -time“[i+l]-time'[i] ; 

b''[03  :  -1  ; 

OutArravX^[0] ; -0 ; 

OutArravY~[0] ; =0; 

for  i;*1  to  NumPolnts-2  do  begin 

temp  :  «3»( ampl* [i  + 1  ] »h*[ i-1  ] -ampl*[i]*(  time''[i  +  1  ] -time“ [i-1  ]  ) 
+ampl''[i-l]*h~[l]  )/(b~[l-1]»h''[i]  ) ; 
b'Cl]  :«2»(tlme“[l  +  l]-tlme''[i-1])-h~[i-1]»0utArrayX*[l-1]  ; 
OutArrayX“[l] :=h*[l]/b“[l]; 

OutArrayY~[l]  :  =(  temp-h* [i-1  ]*0utArrayY''[i-1  ]  )/b*[i]  ; 
end;  {for} 
c"[NumPoints- 1 J : =0; 

for  1 : =NumPolnts-2  downto  0  do  begin 

c^Ci] : =0utArrayY~[i]-0utArrayX~[i]»c~[i+1] ; 

b~[l]  ;  =  (ampl"[l  +  1  ]-ampl"[i]  )/h~[i]-h*[i]«{c'' [i  + 1  ]+2«c* [i ]  )/3; 
d-[l];=(c''[i+1]-c-[l])/(3»h~[i]}; 
end;  {for} 

(**•  Create  NewNumPolnts  evenly  spaced  points  •»«) 

XI : =tlme"[0] ; 

increment : = ( tlme^CNumPolnts-l ]-time~[0] )/(NewNumPoints- 1 ) ; 

1:=0; 

TempXPtr*[0] : =tlme'[0] ; 

TempYPtr"[0] : =ampl“[0] ; 
for  j:=1  to  NewNumPoints-1  do  begin 
X : =X1 +j ’increment ; 
while  X  >  time^Ei]  do  i:=succ{i}; 
temp:  =x-time''[l-l]  ; 

TempXPtr“[j] : =x; 

TempYPtr"[  j  ]  :  =  ampl*[i-1  ]  +  b"[i-1  ] ’temp tc'C  1-1  ]  '•sqr(  temp  ) 

+  d”  [  i  -1  ]  '•sqr(  temp )» temp ; 

end;  {for} 

dispose  (b);  dispose  (c);  dispose  {d);  dispose  (h); 
end;  {CubicSpline} 
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begin  {Fitting) 

(*»•  Calculate  number  of  points  to  Interpolate  •••) 
{»»»  to.  Must  be  a  power  of  two.  *•*) 

i;«MinP; 

while  NufflPolnts  >  Pow2[l]  do  1 ; =succ( 1 ); ' 

NumFreqs : -Pow2[l-1 ] ; 

NewNumPoints : =Pow2[l] ; 
if  SPLINE 

then  CubicSpline 
else  Linear; 

NumPolnts : =NewNumPolnts ; 

ACCEPT: =true; 
time” : =TempXPtr“ ; 
ampl~ : =TempYPtr* ; 
end;  (Fitting) 


(*»***•* . . . * . . . . . ..) 

procedure  Integrate; 
uar 

1  :  Integer;  (.  Counter.  *) 

h  :  real;  (*  Distance  between  successive  points.  *) 


begin  {integrate) 

h : =( time*[NumPolnts-1 ]-tlme“[0] )/{ NumPolnts ) ; 

TempXPtr*[0] : =0; 

for  1:-1  to  NumPolnts-1  do 

TempXPtr*[i]  :  .TempXPtr''[i-l]+0 . 5.h*{ompl'‘[l-l]+ampl“[i]  ) ; 
for  i:.0  to  NumPoints-1  do 
ampl''[i]  :  .TempXPtr“[l] ; 
end;  (integrate) 


procedure  differentiate; 


Two_m 

h 

1 


Integer; 
real ; 
integer; 


(' 


Two_m  =  2*m-1  »  Num  points  in  input  array.  *) 
Distance  between  successive  points.  ♦) 
Counter.  *) 


begin  (differentiate) 

Two_m: =NumPoints-1  ; 

h: =( time" [Two_m] -time* [0] )/(Two_m+1 ); 

TempXPtr"[0] : =0 . 5*( -3.ampl"[0] +4*ampl"[1 ]-ampl"[2] )/h ; 

TempXPtr“[Two_m]  :  =  0 . 5*(  3*ampl"  [Two_m]-4''ampl"[Two_m-1  ] +ampl"[Two_m-2]  )/h ; 
for  i:=1  to  Two_m-1  do 

TempXPtr*[i] : =0 . 5*( ompl" [i+1 ] -ampl"[i-1 ] )/h ; 
for  i:=l  to  Twom  do 

ampl"[i] : =TempXPtr"[i] ; 
end;  (differentiate) 


(*••*• . . . . . . . ........) 

procedure  Tronsf erFunction ; 
var 

i  :  integer;  (.  counter  variable  *) 

s  :  string; 

transfer  :  real;  (•  scaling  factor  .) 

operation  :  char;  (.  operation  to  be  performed  .) 

XAXIS  :  boolean;  («  apply  to  x  or  y  axis?  .) 


begin  { TransferFunct ion ) 

54 


i 


1 


I 


i 


i 


..y 


R.1  tn X.'^'WWVVVYVWjTV. vrirRW^s^jr-ji-^'-jf.Tv^rj'-jrr>nri^- 


APPENDIX  A 


PrlntText  (’Apply  to  x  or  y  axis? 
repeat 

operot Ion : =ReodKey ; 
until  (UpCase( operation)  in  ['X',’ 
if  UpCase( operation)  =  ’X' 
then  X_AXIS:»true 
else  X_AXIS: =false; 

PrintText  (’Factor:  ’.1,23) 

GotoXY  (10,23); 

repeat 

operation : =ReadKey ; 
until  (operation  in 
write  (operation); 
readln  (s); 

Strlng_To_Value  (s, transfer , s) ; 
if  XAXIS 

then  case  operation  of 


.1.21); 


1  do  timo''[i] 
1  do  time''[i] 
1  do  time*[l] 
1  do  time~[l] 


for  1 :  =0  to  NumPoints-1  do  timo''[i]: 
’/’;  for  1:=0  to  NumPolnts-1  do  time''[i]: 
’+’:  for  i;=0  to  NumPolnts-1  do  time*[l] : 
for  i;=0  to  NumPolnts-1  do  time~[l]: 
end  (case) 
else  cose  operation  of 

for  i:=0  to  NumPolnts-l  do  ampl~[l] 
’/’:  for  i:=0  to  NumPoints-l  do  ampl~[l] 
’+’:  for  1 : =0  to  NumPoints-1  do  ampl“[i] 
for  i :  =0  to  NumPolnts-1  do  ampl''[i] 
end;  (case) 

(Transfer Function) 


’  *  ’ 

for  i  : 

for  i  : 

'  + ' 

for  1 : 

for  i  : 

(case) 

=tlme*[i] “transfer 
■  time'' [  i]  /  transfer 
=time~[i]+transfer 
=time''[i] -transfer 


=ampl''[i]  “transfer 
^ampl^Ci] /transfer 
=ampl*[i]+transfer 
=ampl~[i] -transfer 


(•  RemoveMean  colculates  the  mean  of  the  time  domain  data  and  subtracts 
(“  that  value  from  the  entire  array. 

(* 


procedure  RemoveMean; 


1  :  integer; 

sum  :  real; 

begin  (RemoveMean) 
sum: =0; 

for  1:=0  to  NumPolnts-1  do 
sum: =sum+ampl~[i] ■ 
sum: =sum/ (NumPoints ) ; 
for  1:=0  to  NumPoints-1  do 
ampl"[l] : =ampl'[i]-sum; 
end;  (RemoveMean) 


(“  Counter  variable. 

(“  The  mean  of  the  orray. 


procedure  Transform  ( INVERSE : boolean ) ; 
const 

MaxPower  =  12; 


type 

polar 


Mag  :  real; 
Ph  :  real; 
end;  (record) 
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beta 

real ; 

{• 

beta  *  t,max  -  t,mln 

») 

delta 

real ; 

(• 

delta  >  1/beta 

♦) 

i 

integer; 

(« 

counter  variable 

*) 

J 

integer; 

(*• 

counter  variable 

*) 

ans 

char; 

(• 

Apply  window? 

*) 

n 

integer; 

(« 

n  -  2*NumFreqs-1 

*) 

P 

1 . . MaxPower ; 

(• 

Power  of  two  of  FFT 

•) 

sign 

integer; 

{* 

Sign  of  real  part 

*) 

magnitude 

real ; 

(* 

Magnitude  of  real  part 

*) 

StartTime 

real ; 

(* 

Time  at  beginning  of  FFT 

*) 

EndT ime 

real ; 

(• 

Time  when  finished  FFT 

*) 

delta_t 

real ; 

(* 

Time  to  perform  FFT 

*) 

function  timer:  real; 
var 

hour , min , sec , ms  :  word; 
begin 

GetTime  (hour, min, sec, ms); 
timer: =hour»3600  +  min*60  +  sec  +  ms/100; 
end; 


( . . . * . * . . . ) 

(•••  ««») 

(«•*  Cooley_TukeY_FFT  is  modified  from  the  FFT  olgorithm  of  Numerical  *•«) 

(***  Analysis,  3rd  ed.  by  Burden  &  Faires,  p.  404.  The  algorithm  is  ««») 

(•»•  based  on  the  Cooley-Tukey  FFT  algorithm.  «««) 

(•««  •»•) 

( . . . . . . . * . . . . . . . -) 


procedure  Cooley_Tukey_FFT; 


type 

bihary  •  0 .  .  1 ; 

BinoryArray  =  array  [0 . .MaxPower]  of  binary; 


var 

big_M 

big^K 

q 

L 

k 

K2 

eta 

temp 

i 

j 


Integer; 

(* 

integer; 

(• 

integer; 

(' 

integer; 

(* 

BinoryArray; 

(" 

integer; 

(*  Subscript  after  bit  reversal 

polar; 

(* 

polar; 

integer; 

integer; 

(“  Used  to  switch  two  values. 

•) 

«) 

*) 

*) 

*) 

*) 

*) 

•) 


. 


■A 


begin  {Cooley_Tukey_FFT) 

OutArrayX“[0] : =1 ; 

OutArrayY“[0] : =0; 

for  1:=1  to  NumFreqs  do  begin 

OutArrayX"[i] : =cos( i*PI/NumFreqs ) ; 
OutArrayY''[i]  :  =  sin(  i *P I /NumFreqs ) ; 
OutArrayX''[i+NumFreqs]  :  --OutArroyX^[i] ; 
OutArrayY'‘[i+NumFreqs]  :  =-OutArrayV^[i] ; 
end;  (for) 
big_K: =0; 
big_M: =NumFreqs; 
q;=p; 

for  L;=1  to  succ(p)  do  begin 
while  big_K  <  n  do  begin 

for  j:=1  to  big_M  do  begin 
for  1 : =0  to  p  do 
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k[i] ; =blnary( (blg_K  AND  (1  shl  l))  shr  1); 
K2:.0: 

for  i:«p  downto  q  do 

K2:-K2+(k[i]  shl  (p-l+q)); 
eta.  Mog;  =TetnpXPtr''[blg_K+blg_M]»0utArrayX"[K2] 
-Temp VPtr*[blg_K+big_M]*OutAr ray Y“[K2]  ; 
eta . Ph  : sTempXPtr" [blg_K4big_M]*0utArrayY~ [K2] 
+TempYPtr“[blg_K+big_M]»OutArrayX“[K2]  ; 
TempXPtr“[blg_K+blg_M] : *TempXPtr"[big_K]-eta .Mag; 
TempYPtr'[big_K+blg_M] : =TempYPtr*[big_K]-eta . Ph ; 
TempXPtr''[blg_K]  :  =TempXPtr~[blg_K]+eta . Mo j ; 
TempYPtr^[big_K]  :  =TempYPtr''[blg_K]+eta .  Ph ; 
big_K: =succ( blg_K) ; 
end;  {for} 
blg_K: *blg_K+blg_M; 
end;  (while) 
big_K: =0; 

blg_M:=big_M  div  2; 
q:=pred(q); 
end;  (for) 

while  big_K  <  n  do  begin 
for  1;=0  to  p  do 

k[i] : =blnary( ( blg_K  AND  (1  shl  i))  shr  i); 
j:=0; 

for  1;=0  to  p  do 

j:<=j  +  (k[l]  shl  (p-i)); 
if  j>blg_K  then  begin 

temp . Mag : =TempXPtr* [ J ] ; 
temp.Ph  : =TempYPtr* [ j ] ; 

TempXPtr'‘[j  ]  .  «TempXPtr*[big_K]  ; 

TempYPtr'Cj] : =TempYPtr'[big_k] ; 

TempXPtr''[blg_K]  ;  "temp  .  Mog; 

TempYPtr*[blg_K] : =temp . Ph ; 
end;  (if) 
big_K: =succ( big_K ) ; 
end;  (while) 
end;  (Cooley_Tukey_FFT} 


(***  ••*) 

(*“»  Results  of  previous  procedures  in  Transform  ore  given  as  real  and  »«•) 

{•»»  imaginary  ports.  PolorForm  converts  those  values  to  mognitude  ond  *•«) 

(«««  phase  (radians)  components.  *•*) 

(•*•  »*») 

(*••  Arg  =  the  counterclockwise  angle  between  the  positive  half  of  the  ««») 

(•»*  real  axis,  and  the  ray  from  the  origin  to  the  complex  number.  •**) 

{*•*  »»*) 


procedure  PolarForm; 
const 

epsilonl  =  1e-06;  (*  A  tolerance.  Anything  <=■  epsilon!  is  0.  *) 

epsilon2  *  1e-02;  (*  A  tolerance.  Any  angle  <=  epsilon2  is  0.  *) 

vor 

i  :  integer;  (*  A  counter  vorioble.  *) 

temp  :  polar;  (»  A  temporary  variable.  *) 

konst!  real;  (*  Correction  factor  for  phose  angle.  ») 

konst2  :  real;  (*  Magnitude  scale  factor  for  forward  FFT.  *) 

Max  real;  (»  Maximum  mognitude  of  frequency  data.  *) 

function  Arg  (vipolar)  real; 

begin  (Arg) 
if  v.Mag>=0 
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then  konst1:»0 
else  if  v.Ph>»0 
then  konst1;»PI 
else  konsti :  =>-PI ; 
if  abs(v.Mog)  <«  epsiloni 
then  if  v.Ph>=0 
then  Arg;<=+PI/2 
else  Arg:>=-PI/2 

else  Arg : =arctan( v . Ph/v .Mag)+konst1 ; 
d;  {Arg) 


begin  (PolarForm) 

konst2 : =2»NumFreqs*delta ; 
for  i:=0  to  n  do  begin 
temp . Mag ;  =TempXPtr''[i]  ; 
temp.Ph  ;  =TempYPtr''[i]  ; 

TempXPtr"[i] ; =sqrt( sqr( temp . Mag )+sqr( temp . Ph ) )/konst2 ; 
TempYPtr''[i]  :  =Arg  (temp); 
end;  {for) 

(»«•  Eliminate  "unreal"  phase  angles.  «»») 

Max;  =TempXPtr''[0]  ; 
for  i:=1  to  n  do 

if  {Max  <  TempXPtr''[i]  )  then  Max :  =TempXPtr"[i]  ; 
for  i ; =0  to  n  do 

if  (TempXPtr''[i]  <  Max''epsilon2)  then  TempYPtr*[i]  :  =0; 
end;  {PolarForm) 


begin  {Transform) 

p ;  "round{ ln{NumFreqs)/ln(2 ) ) ; 
n  :  =2*NumFreqs-1 ;  ("  •  NumPoints-1  ") 


if  NOT  INVERSE 
then  begin 

{»*«  Should  a  window  be  applied  to  the  time  domain  data?  *»«) 

PrlntText  ('Apply  window  [H/R/N]?  ',1,22); 

ClrEOL; 
end  (then) 
else  begin 

PrlntText  ('Inverse  FFT  in  progress.  Please  wait  ...',1,22); 

ClrEOL; 
end;  (else) 


(*•*  Make  variable  assignments  while  user  reads  prompt, 
if  INVERSE 
then  begin 

beta : =n/( freq~[n]-f req"[0]  ) ; 

(*•»  Reorder  data  for  inverse  FFT  ««») 
for  1:=0  to  n  do  begin 

TempXPtr"[l]  ;  =mag' [l]  *cos{ phase'' [i]  ) ; 
TempYPtr'Cl] ; =mag~[i]"sin( phase" [i] ) ; 
end;  (for) 
delta : =beta/( n+1 ) ; 
end  (then) 
else  begin 

for  i:=0  to  n  do  begin 
TempXPtr"[i] : =ampl"[l] ; 

TempYPtr* [i] ; =0 ; 
end;  (for) 

delta : =1 /( time" [n] -time" [0] ) ; 
end;  (else) 


If  NOT  INVERSE  then  begin 

GotoXY  (23,22);  ans ; =ReadKey ; 
if  ( UpCase( ans )= ' H ' )  then 
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for  1:»0  to  n  do  (***  Apply  Honning  window  •*») 

TempXPtr~[i] ; -TempXPtr“[l]*(0 .5*( 1-eos( PI»l/NumFreqs) ) ) 
else  if  (UpCase(ans)-'R' )  then 

for  l:-0  to  n  do  (*»*  Apply  roar  window  ••») 

TenipXPtr“[i]  ;  -TempXPtr''[l]*(0 . 5»(  1-cos(  (0 . 5»PI*i/NumFreqs)+PI ) ) ) ; 
if  ons  <>  ENTER 
then  write  (ons) 
else  write  ( ' N’ ) ; 

PrintText  ( ' FFT  in  progress.  Please  wait  ...’,1,22); 

ClrEOL; 
end;  (if) 

(«*•  Perform  FFT  or  IFT  on  data.  »««) 

StartT ime : =timer ; 

Cooley_Tukey_FFT ; 

EndTime: =timer; 

delta_t;  =EndTlme-StartTlme; 

•  GotoXY  (1,20); 

write  ('FFT  performed  in  ' , delta_t : 6: 1 ,  ’  seconds.’); 

(*«»  Prepare  output  arrays.  »♦») 
if  INVERSE 
then  begin 

for  l:=0  to  n  do  begin 

sign : »round(TempXPtr*[n-i]/abs(TempXPtr~[n-i] ) ) ; 
magnitude:  =sqrt(  sqr(TempXPtr*[n-i]  )+sqr(TempYPtr''[n-i]  ) ) ; 
tlme“[l]  :  ■=l*delta; 
ampl*[l] : =slgn“magnitude/beta; 
end;  (for) 
end  (then) 
else  begin 

I  (»••  Convert  real  ond  imaginary  parts  •••"•) 

(»«•  to  magnitude  and  phase  ports.  »»•) 

PolarForm; 

for  i;»0  to  n  do  begin 
freq~[l]  ;«i«dolta; 

'  mag“[l]  ; =TempXPtr*[l] ; 

phaso''[l]  ;  •'TempYPtr*[l] ; 
end;  (for) 
end;  (else) 
end;  (Transform) 


•  »*» 

«  *  » 

44«44  ^ 

««« 

SPS  prints  the  SPS  menu,  and  gives  the  user  the 

choice  of  one  of 

«  «  44  ^ 

««» 

several  signal  processing  functlns: 

44  44  *  J 

44  44  44  ^ 

«  »  » 

1.  Integration  of  time  domain  data. 

44  44  44  ^ 

»  41  » 

2.  Differentiation  of  time  domain  data. 

44  44  #  J 

»  •  4» 

3.  Fast  Fourier  Transform  of  time  domain  data. 

#  «  #  ^ 

«  44  44 

4.  Adjust  (+,-,*,/)  time  domain  amplitude  by 

a  constont. 

»»#  ^ 

44  »  « 

5.  Multiply  time  base  by  a  factor. 

#  «  W  ^ 

44  »  44 

6.  Subtract  the  mean  of  the  time  domain  waveform. 

»  «  #  ^ 

44  44  44 

#  «  #  ^ 

44  44  44 

SPS  is  called  AFTER  the  data  has  been  fitted,  a 

procedure  invoked 

»#»  ^ 

44  44  44 

the  first  time  one  chooses  selection  5  from  the 

Main  Menu. 

»44  44 

»  44  44  » 

4  44  44  44  44«l4n  44  44  44  44  44  44  44  44  44  44  44< 

«  »  »  ^ 

procedure  SPS; 

procedure  SPSMenu; 
vor 

Choice  :  char; 
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begin  (SPSMenu) 

ClrScr; 

PrlntToxt  ('Signal  Processing  Menu', 6.1); 
PrintText  ('Select  Option  by  typing  o  number; 


M  ,  3 ) ; 


PrintText  ( ' 1 . 
PrintText  ( ' 2 . 
PrintText  (  '  3 . 
PrintText  ('4. 
PrintText  (  ' 5 . 
PrintText  (  '  6 . 
PrintText  ( ' 9 . 


Integrate 

Differentiate 

FFT 

Inverse  FFT 
Transfer  Function 
Remove  DC  Level 
Exit  to  Main  Menu 


PrintText  ('Your  Choice? 

GotoXY  (14,22); 

repeat 

Choice : -ReodKey ; 
until  Choice  In  [ ' 1 ' . . ' 6 ' , ' 9 ' 
MalnChoice: =ord(Cholce)-ord(  ' 
write  (MalnChoice); 
end;  (SPSMenu) 

begin  (SPS) 

Window  ( StartColumn-1 , 2 , 80 , 25 ) ; 
DONE : =false; 

If  NOT  ACCEPT  then  Fitting; 
repeat 

SPSMenu ; 

case  MalnChoice  of 


.9,6); 

,9.8); 

.9.10) 

.9.12) 

.9,14) 

.9,16) 

.9,18) 

.1.22) 


]; 


5 

6 
9 

end ; 
until  DONE; 

DONE: =false; 

Window  (1,1,80,25) 
ClrScr ; 
end;  (SPS) 


Integrate; 
Differentiate; 
begin  (Transform) 
Transform  (false); 
TRANS: »true; 

ORIG : ■false; 
end;  (Transform) 
if  TRANS  then  begin 
Transform  (true); 
ORIG: “true; 
end;  (Inverse  FFT) 
Tran sferFunct Ion ; 
RemoveMean ; 

DONE : “true ; 

(case) 


begin  (Initialization) 
end.  (Initialization) 
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A-3.4  AdvancedOpts 

Unit  AdvancedOpts  contains  two  routines: 

1.  AdvancedOptions  and 

2.  Read_DefaultOptions. 

Procedure  AdvancedOptions  allows  the  user  to  change  the  type  of  inter¬ 
polation  used,  the  background  and  foreground  colors  used  on  color 
monitors,  the  port  to  which  the  digitizer  is  connected,  whether  a  printer  is 
installed,  and  the  default  drive/directory  for  data.  The  user  may  also  save 
these  options  to  a  disk  file  called  "FFT.cfg"  on  the  current  drive/directory. 

Procedure  Read_DefaultOptions  reads  the  options  saved  to  disk  from  the 
file  "FFT.cfg"  if  it  exists.  This  file  is  only  read  when  program  FFT  is  first 
started. 
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unit  AdvancedOpts ; 

Interface 

uses 

Crt, 

Graph, 

Global ; 


(  . . . . ) 

f »«»  ««» ) 

(■"**  AdvancedOptlons  allows  several  options  to  be  changed.  duo) 

(*»»  »»») 

. . . 


procedure  AdvancedOptions ; 


( . . . . . . . ) 

(«»»  «•» ) 

(■**  8ead_Default_0ptions  reads  the  default  options  file  that  was  saved  «»») 
(x»i>  previously  by  the  user  under  the  advanced  options  menu.  ««■>) 

(»«»  «««) 


procedure  Read_DefaultOptlons; 


( 

( 


implementation 
procedure  AdvancedOptlons: 


const 

Max?  =  12; 

Pow2  :  array  [6 . . 12]  of  Integer 

=  (32.64.128,256,512.1024.2048.4096); 

var 

choice  :  byte; 

Int  :  char; 

DONE  :  boolean; 

NewNum  ;  integer; 
temp  :  string; 

Name  :  text; 
error  :  Integer; 
ch  :  char; 

Drive  :  byte; 

CurrentDlr  :  string; 


procedure  AdvancedOptlonsNenu; 


begin  ( AdvancedOptionsHenu) 

ClrScr ; 

Window  (StartColumn-1,2,80,25 ); 

PrlntText  (’Advanced  Options’ ,9,1 ); 

PrlntText  ( ’Select  Option  by  typing  a  number: 
PrlntText  (’1.  Linear/Spline  Interpolation: 
PrlntText  (’2.  Digitizer  Port  [0/1/2]; 
PrlntText  ( ’3.  Printer  Installed  (y/n)  7 


’.1.3); 

’.6,6): 

•.6.8): 

’.6,10): 
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PrintText  (’4.  Colors:  ’,6,12) 
PrintText  (*6.  Data  Dlsk/Dlrectory:  ’,6,14) 
PrintText  (’6.  Save  Options  ’,6,16) 
PrintText  (’9.  Exit  to  Main  Menu  ’,6,18) 
PrintText  (’Your  Choice?  ’,1,22) 


GotoXY  (40.6); 

if  SPLINE 

then  write  ( ’S’ ) 
else  write  ( ’L’ ); 

GotoXY  (40,8);  write  (SerlalPort); 

GotoXY  (40.10); 

if  NoPrlnter 

then  write  ( ’N’ ) 
else  write  ( ’Y’ ); 

GotoXY  (33.12); 

write  (ForeColor:2, ’/ ’ ,BackColor:2, ’/’ ,DrawColor:2); 

GotoXY  (30,14);  write  (DefaultDataOir:ll ); 

DONE:  =f also; 

end;  ( AdvancedOptlonsMenu) 


begin  ( AdvancedOptions } 
AdvancedOptlonsMenu ; 
repeat 

GotoXY  (14,22); 
repeat 

ch:=ReadKey; 

until  ch  in  [’1’ . . ’6’ , ’9’]; 
choice :=ord(ch)-ord( ’0’ ); 
write  (ch); 
case  choice  of 
1:  begin 

GotoXY  (40,6); 
if  SPLINE 
then  begin 

SPLINE :»false; 
write  (’L’); 
end  ( then) 
else  begin 

SPLINE : =true ; 
write  (’S’); 
end;  (else) 
ACCEPT :=false; 
end; 

2:  begin 

GotoXY  (40,8); 
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4:  begin 

GotoXY  (30,12);  ClrEOL; 

GotoXY  (1,22): 

write  (’Foreground  color  .ForeColor , *]  ?  ’): 

ClrEol; 

readln  (temp); 

Tal  (t«iip,NewNum, error); 

If  error  »  0  then  ForeColor:=NewtJum  mod  16; 

GotoXY  (1,22); 

write  ('Background  color  [’ .BackColor, ’]  7  ’ ); 

ClrEol; 

readln  (temp); 

Tal  (temp,NewNum,error ); 

If  error  =  0  then  BackColor :=NewNum  mod  16; 

GotoXY  (1,22); 

write  (’Drawing  color  [ ’ .DrawColor, ’]  7  ’); 

ClrEol; 

readln  (temp); 

Tal  ( temp , NewNum , error ) ; 

If  error  =  0  then  DrawColor :=NewNum  mod  16; 

If  GraphlcsCard  <>  HercMono  then  begin 
TextColor  (ForeColor); 

TextBackgrotind  ( BackColor ) ; 
end;  (If) 

Window  (1,1,80,25); 

AdvancedOptlonsMenu ; 
end; 

6;  begin 

PrlntText  (’Mew  data  dl8k/dlrectory7  ’,1,22); 
readln  (temp); 

If  length  (temp)  >  0  then  begin 
Drivei=0; 

GetDlr  ( Drive , CurrentDlr ) ; 

($!-}  ChDir  (temp);  ($1+) 

If  lOResult  =  0 
then  begin 

Def aultDataDlr : =temp ; 

ChDlr  ( Ciu'rentDlr ) ; 

GotoXY  (30,14); 

write  (DefaultDataDlrill);  ClrEOL; 
end  ( then) 
else  begin 

PrlntErrorMsg 

(’Invalid  disk/directory!  ’ ,1,19, false, ch); 
end;  (else) 
end;  (if) 

PrlntText  (’Your  Cholce7  ’,1,22);  ClrEOl; 
end; 

6:  begin 

PrlntText  (’Saving  Options.  Please  wait  ...’,1,22); 

Assign  (Name,OefaultOptlons); 

Rewrite  (Name); 

If  SPLINE 

then  wrlteln  (Name, ’SPLINE  Interpolation’) 
else  wrlteln  (Name, ’LINEAR  Interpolation’); 
wrlteln  (Name, ’Digitizer  at  COM’ ,SerlalPort , ’ : ’  ) ; 

If  MoPrlnter 

then  wrlteln  (Name, ’NO  Printer  installed’) 
else  wrlteln  (Name, ’Printer  Is  Installed’); 
wrlteln  (Name, ’Foreground  Color  Is  ’, ForeColor :2 ) ; 
wrlteln  (Name, ’Background  Color  Is  ’ ,BackColor:2 ) ; 
wrlteln  (Name, ’Drawing  Color  Is  ’, DrawColor :2 ) ; 
wrlteln  (Name, ’Default  data  directory  Is  ’ ,DefaultDataDlr ) ; 
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Close  (Hame); 

PrintText  ('Your  Choice?  *,1,22);  ClrEOL; 
end; 

9:  begin 

DONEs«true; 

Window  (1.1.80.26); 

ClrScr; 

end; 

end;  (case) 

PrintText  (*  *.14.22); 
until  DOME; 

end :  { AdvancedOpt Iona } 


procedure  ReadJDefaultOptlons; 
var 

Name  :  text; 
temp  :  string: 
l.d  :  byte; 
error  :  integer ; 
num  :  string  [8]: 

begin  (Read_DefaultOptlons} 

If  EXIST  { DefaultOptlons )  then  begin 
Assign  (Name. DefaultOptlons); 

Reset  (Name); 
readln  (Name. temp); 
ii^Pos  (’SPLINE ’.temp); 
if  1  >=  1 

then  SPLINE: =true 
else  SPLINE; >:f else; 
readln  (Name. temp); 
i:=Pos  ( ’COM’ .teqp); 

SerialPort:>ord(temp[i43] )-ord( ’0’ ); 

If  NOT  (SerlalPort  In  [0. .2])  then  SerlalPorti^O; 
readln  (Name. temp); 

If  temp[l]  in  [’P’.’p’] 
then  MoPrlnter:=falae 
else  MoPrlnter:=true; 
readln  (Name, temp); 
l:=Pos  (’Is  ’.temp); 
num:=copy  (temp.  14-3,2); 

Tal  ( nun, 1, error ); 
if  error  =  0  then  ForeColor:=l; 
readln  (Name, temp); 
l:=Pos  (’is  ’.temp); 
num:=copy  (temp,l'>'3,2); 

Tal  (num, 1, error); 
if  error  -  0  then  BackColor:=i; 
readln  (Name, temp); 
i:=Pos  (’Is  ’.temp); 
num:=copy  (temp,l'»-3,2); 

Tal  (num, 1, error ); 

If  error  =  0  then  DrawColor:=i; 
readln  (Name, temp); 
i:»Pos  (’Is  ’.temp); 
if  1  >  0  then  begin 

for  ] :  si-f3  to  length(  temp )  do 
DefaultDataDlrCJ -1-2] : =temp[J ] ; 
DefaultDataDlr [0] : =char  ( length( temp )-i-2 ) ; 
end;  { If) 
end;  { If) 
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FileSystem 

Unit  FileSystem  performs  all  the  file  operations  of  this  program.  FilelO 
first  sets  up  a  menu,  then  saves,  retrieves,  or  deletes  a  file  from  disk.  In 
addition,  a  file  may  be  imported  from  the  Device  Damage  Testing  (DDT) 
programs  written  by  James  Loftus  of  Harry  Diamond  Laboratories,  a  disk 
directory  may  be  listed,  or  the  information  lines  of  a  data  set  may  be  dis¬ 
played.  The  following  procedures  and  functions  are  contained  in  this  file: 

1 .  SaveFile-saves  data  to  disk. 

2.  RetrieveFile-retrieves  data  from  a  disk  file. 

3.  DeleteFile-deletes  a  disk  file. 

4.  ImportDDT— imports  a  DDT  file. 

5.  Directory— gives  a  directory  listing. 

6.  ReadInfoLines-displays  the  information  lines  of  a  data  set. 


J I JBJAJ,  PAUJMU  jiJ'JU  J  JH 


■B53ivwiArwwyTOwn«7Pawn;if\jrMnurofXTOnaiTt  wwkT<  vvw\ninJVWLVW\v'An\;^  R.’i  it.",  «.n’yvyvw\.v^nA.%^-s^jvv’^T’z^  t/r^^  v.^t.tvt  r>j'ja\7V'7<rw\n\rnviw 


» 


APPENDIX  A 


( . * . * . . . 

^  *** 

(...  FilelO  saves,  retrieves,  or  delete",  files  from  disk.  Data  files 
(...  will  be  saved  as  follows: 

(...  1.  Number  of  elements. 

(...  if  ORIG  then  this  is  NumPoints 

(...  if  TRANS  then  this  is  2»m. 

(...  2.  X,  Y  (the  time  domain  data  point) 

(**•  if  applicable,  the  following  is  then  saved; 

(...  3.  f req . ,  mag.,  phase  (the  frequency  domain  points) 

(...  4.  From  0  up  to  Maxinfo  number  of  information  lines, 

( 

(...  Additionally,  files  may  be  "Imported"  from  the  Device  Damoge 
(...  Testing  (DDT)  programs.  When  imported,  the  DDT  file  is  translated 
(...  to  the  format  listed  above.  The  operotor  is  also  given  the  option 
(...  of  scaling  the  Integer  values  of  the  DOT  files  to  "true"  values. 

( *#* 

(...  A  directory  may  also  be  shown  by  giving  a  file  mask.  The  file  mask 
(...  is  of  the  form  [d :] [path] [fi lename] [. ext] .  Wildcards  may  be  used. 

( . . . . . . . 


»  »  « 


»  «  « 
*«« 


»  •  • 
»  »  « 


»  W  « 
«  »  « 


*  «« 
»  «  « 


) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 

) 


unit  FileSystem; 

Interface 

uses 

DOS, 

Crt , 

Global; 


procedure  FilelO; 


implementation 


vor 

Response, Choice 

counter 

OKSave 

lODONE 

Name 

RespCh 


shortint ; 
Integer ; 
boolean ; 
boolean ; 
text; 
char; 


(.  FilelO  menu  choices 
(.  counter  variables 
(.  overwrite  old  file? 

(.  exit  FilelO? 

(*  file  Input/output  stream 


*) 

*) 

*) 

*) 

*) 


( . * . . . . . . . ..,.) 

(*#*  ##») 

(***  SoveFile  tests  if  the  specified  filenome  alreody  exists.  If  so.  the  ***) 
(***  user  is  asked  if  the  old  file  should  be  overwritten.  If  so.  or  if  ***) 
(*w#  the  old  file  does  not  exist,  then  the  date  is  soved  as  filename  and  *•*) 
(***  the  user  is  returned  to  the  Main  Menu,  otherwise  the  user  is  ***) 

(##»  returned  to  the  FilelO  Menu.  ***) 

( **•  ) 

(•**"*** . * . . . . . * . ) 


procedure  SoveFile; 


1  :  Integer; 
filename  ;  string; 


3 


begin  {SoveFile) 
OKSave: =false; 
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f ilenQme[0] : =char( 0 ) ; 

PrlntText  (’Save  to  filename:  ’,1,22); 

ReadLn  (filename); 

if  filename[2]  <>  ’:’  then  if  filename[1]  <>  ’\'  then 
filename : »DefaultDataDir+ ’ \ ’ +f llename; 

(»“•  Does  file  exist?  If  so,  is  it  safe  to  overwrite  it?  •»*) 
if  NOT  EXIST  (filename) 
then  begin 

if  length  (filename)  >  0 
then  OKSave:=true 
else  OKSave: =false; 
end  (then) 
else  begin 

PrintErrorMsg  (’File  already  exists:  overwrite  (y/n)?  ’, 

1,19, true , RespCh  ) ; 

if  (UpCase(char( RespCh ))=’ Y’ ) 
then  OKSave :=true 
else  OKSave : =false ; 
end;  (else) 

(»*»  If  If  Is  safe  to  write  to  the  file,  then  sove  the  data.  »••) 
if  OKSave 

then  begin 

($1-)  ( »  Turn  off  error  checking.  “) 

PrlntText  (’Saving.  Please  wait...  ’,1,20); 

Assign  (Name , f i lename ) ; 

Rewrite  (Name); 
if  TRANS 

then  writeln  (Name, 2*NumFreqs) 
else  writeln  (Name, NumPoints) ; 
if  ORIG 

then  for  i:=0  to  NumPoints-1  do 

writeln  (Name, tlme'Cl] : precision , ’  ’, 

ampl^Ci] :preciSion) 
else  for  l;=0  to  2»NumFreqs-1  do 

writeln  (Name, tlme*[l] : precision, ’  ’, 

ampl*[i] ;preclSion, ’  ’, 

freq"[l] : precision, ’  ’, 

mag~  [i] : precision , ’ 
phase" [i] : precision ) ; 
for  1:=1  to  Moxinfo  do 
writeln  (Name, info[i]  ); 

Close  (Name); 

PrlntText  (’  ’,1,20); 

PrlntText  ( ’  ’,1,22); 

($1+)  (*  Turn  error  checking  on.  *•) 

if  (lOResult  <>  0)  then  begin 

PrintErrorMsg  (’Error  on  disk.  File  not  saved!  ’, 

1 , 22, false, RespCh  ) ; 

end;  (if) 
end  (then) 
else  begin 

PrlntText  (’Yaur  Choice?  ’,1,22); 

end;  (else) 
end;  (SaveFile) 


( . * . . . . . * . - . * . * . ) 

(  *•*  *•*  ) 

(m****  RetrieveFile  first  calls  EXIST.  If  the  file  exists,  then  the  file  *•«♦») 
(***  is  read  and  the  user  is  returned  to  the  Main  Menu;  otherwise  the  *»») 

(*»»*  user  is  given  an  error  messoge  and  returned  to  the  FilelO  Menu.  *«*) 

( . . . . . . . . ) 


procedure  RetrieveFile; 
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var 

J  :  integer;  (*  temporary  counter  vorioble  *) 

X  :  reol;  (*  dummy  variable  *) 

y  :  real;  (*  dummy  variable  *) 

1  :  integer; 
filename  ;  string; 


begin  (RetrieveFile) 

PrintText  (’  ’,1,20); 

PrintText  (’Read  filename:  ’,1,22); 

ReadLn  (filename); 

if  filename[2]  <>  ’:’  then  if  filename[l]  <>  ’\’  then 
filename: =DefaultDataDlr+ ’ \ ’ +f ilenome; 

(**»*  Does  file  exist?  if  not,  ERROR!  If  so,  read  the  file,  ***) 
if  NOT  EXIST  (filename) 
then  begin 

PrlntErrorMsg  (’File  does  not  exist !’, 1 , 1 9 , false , RespCh ) ; 
PrintText  (’Your  Choice?  ’,1,22); 
end  (then) 
else  begin 

PrintText  (’Reading.  Please  wait  ...  ’,1,20); 

Assign  (Name, filename) ; 

Reset  (Name); 

TRANS: =false; 

ORIG: =false; 

ACCEPT: =false; 

Readln  ( Name , NumPolnts ) ; 
read  (Name,x,y); 
if  NOT  EOLN  (Name) 
then  begin 

readln  (Name ,  freq*[0]  ,  mag''[0]  ,  phase* [0]  ) ; 

TRANS: -true; 
end  (then) 
else  begin 
ORIG; -true; 
freq''[0]  ;  -0; 
mag''[0]  :  -0; 
phase''[0]  :  =0; 
end;  (else) 
tlme*[0] : -x; 
ampl~[0] : =y ; 
if  TRANS 

then  for  1:=1  to  NumPoints-1  do  begin 
Readln  (Name, time"[l] , 
ampl*[i] , 
freq'il] , 
mag*[l] , 


phose'[l ] ) ; 

end  (then  for) 

else  for  i:=1  to  NumPolnts-1  do  begin 
Readln  (Name, time"[i1 , 
ampl"[i]): 

freq"[i]  :=0; 
mag*[i]  :=0; 
phase"[l] : =0; 
end;  (else  for) 
if  TRANS 

then  begin 

NumFreqs: -NumPoints  div  2; 

ACCEPT : -true ; 
end  (then) 
else  begin 

ORIG: -true; 
end;  (else) 
i  :  =1  ; 

while  (NOT  EOF  (Name))  AND  (l  <=  Maxinfo)  do  begin 


mm. 
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end; 


Readln  (Nome, lnfo[l] ) ; 
i : -succ( 1 ) ; 
end;  {while) 
for  J:«l+1  to  Mdxlnfo  do 
lnfo[i] ; =blank; 

Close  (Nome); 
end;  (else) 

(RetrleveFile) 


(• 


•) 


^  » 

^  »«» 

^  « 


DeleteFile  deletes  o  file,  if  present,  from  disk,  after  asking  the 
user  to  verify  that  he  wonts  to  delete  it. 


•  «  «  ^ 
•  «  »  ^ 
»  *  »  ^ 
«  «  »  ^ 


(• 


') 


procedure  DeleteFile; 


filename  ;  string; 


begin  (DeleteFile) 

PrintText  ('Delete  filename:  ‘,1,22); 

ReodLn  (filename); 

if  filenotre[2]  <>  then  if  fllename[1]  <>  ’\’  then 
filename; =DefaultDataDlr+ ’ \ '+fllename; 
if  EXIST  (filename)  then  begin 

PrintErrorMsg  ('Delete  file  (y/n)?  ' , 1 , 19 , true, RespCh ) ; 
if  ( UpCase( RespCh )  =  "^ ' ) 
then  begin 

Erase  (Name); 
end  (then) 
else  begin 

PrintText  ('Your  Choice?  ’,1,22);  ClrEOL; 
end;  (else) 
end;  (then) 

PrintText  ( ' 

PrintText  ('Your  Choice?  ’,1,22); 
end;  (DeleteFile) 


.1.20); 


(• 


(• 


(*»  This  procedure  is  a  file  translation  utility.  It  will  translate  a 
(*•  file  from  the  Device  Damage  Testing  program  format  to  the  formot 
(*•  required  of  this  waveform  analysis  program. 

(.. 

( . . . - . . . 


*  *  J 


procedure  ImportDDT ; 


const 

NumVertPolnts 


512; 


(•  Num  vert  points  on  7912  digitizer  *) 


delta 

1 

SCALE 

DummyChar 

VoltsDiv 

Transfer 

filename 


real ; 
integer; 
boolean ; 
char; 
real ; 
real ; 
string; 


Dist  between  successive  data  pts. 

A  counter  variable 

Scole  dota  to  reel  values? 

Reads  dummy  char  information 
Volts  /  div  of  digitizer 
Tronsfer  function  of  probe 


procedure  ReadlDStrlngs ; 


type 

CodeRange  0..2; 
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var 


SecondsDlv 

:  real ; 

VMax 

:  real; 

VMin 

:  real; 

TMox 

:  real; 

dummy 

:  string; 

DlskNum 

:  Integer 

Code 

:  Integer 

OKAY 

:  boolean 

procedure  ReodString  (VAR  StringToRead  ;  string; 

EndCode  :  CodeRonge); 

var 

DONE  :  boolean;  (*  Done  reodlng  string? 

begin  (ReodString) 

DONE: -false; 

i:-0; 

repeat 

1 ; -succ( 1 ) ; 

read  (Name, StrlngToRead[l] ); 
case  EndCode  of 

0:  if  StringToRead[i]  =  then  DONE:=true; 

1:  if  StringroRead[i]  =  then  DONE: -true; 

2:  if  EOLN  (Nome)  then  DONE: -true; 

end;  (case) 
until  DONE; 

StringToRead[0] : =char( i-1 ) ; 
end;  (ReodString) 

begin  (ReadIDStrings) 

Readstring  (dummy, 0); 

Val  (dummy , NumPoints, Code) ; 

NumPoints: -succ (NumPoints ) ; 

read  (Name,DummyChar); 

Readstring  (dummy,!); 

info[1] :-'NAME  OF  FILE:  ’+dummy; 

read  (Name, DummyChor ) ; 

Readstring  ( dummy, 0); 

if  dummy[1]  -  then  dummy :- '0' +dummy; 

Val  (dummy , VoltsDiv , Code) ; 
lnfoi2]; -’AMPLITUDE  /  DIV:  '+dutnmy; 

Readstring  (dummy, 0); 

if  dummy[l]  -  then  dummy 0 ’ +dummy; 

Val  (dummy , SecondsDlv, Code) ; 

lnfo[3] : - ' SEC  /  DIV:  ’+dummy; 

delta ;  =1 0'‘SecondsDiv/pred(  NumPoints ) ; 

Readstring  (dummy, 0); 

if  dummy [1]  -  then  dummy '0’+dummy; 

Val  (dummy , VMax , Code) ; 
info[4]:- 'MAX  AMPLITUDE:  ’+dummy; 

Readstring  (dummy, 0); 
if  dummy [ 1 ]  =  ' . ' 

then  dummy  :  =  ' 0 ' +dunimy 

else  if  ((dummy[l]  -  '-’)  AND  (dummy[2]  -  ’.')) 
then  begin 

dummy [ 1 ] :  =  ’ 0 '  ; 
dummy : = ' - ' +dummy ; 
end;  (else  if) 
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Val  (dummy ,  Tl*lax,  Code) ; 

infois]:-  TIME  OF  MAX  AMPLITUDE;  ’+dummy, 
Readstring  (dummy, 0); 

if  dummy[l]  »  then  dummy ;=' 0 ’ +dummy ; 

Val  (dummy , VMin , Code) : 

info[6]:  =  ’MIN  AMPLITUDE;  ■+dummy, 

read  (Name, DummyChar ) ; 

Readstring  (dummy, 1); 
read  (Name, DummyChar ) ; 
info[7]  ;  - 'TIME ;  *+dummy, 

read  (Name, DummyChar ) ; 

Readstring  (dummy, 1); 
info[8] ; = ' DATE :  '+dummy; 

read  (Name, DummyChar ) ; 
read  (Name, DummyChar) ; 

Readstring  (dummy, 1); 
read  (Name, DummyChar ) ; 
info[U];  = 'COMMENTS;  •+dummy. 

Readstring  ( dummy, 0); 

if  dummy[1]  =  then  dummy ;= ’0’+dummy; 

Val  (dummy , Transfer , Code); 
lnfo[9];='TRANSFER  FUNCTION;  ■+dummy; 

read  (Name, DummyChar ) ; 

Readstring  (dummy, 1); 
read  (Nome, DummyChar ) ; 
info[l0]  OTHER;  '+dummy, 

ReadLn  (Name, DiskNum) ; 

info[1li;.’DISK  NUMBER:  ’ +char(OiskNum+ord( ’ 0 ’  ) ) ; 

read  (Name, DummyChar); 

Readstring  (dummy, 1); 
read  (Nome, DummyChar) ; 
info[12]:='DEVICE  UNDER  TEST;  ’+dummy: 

read  (Name, DummyChar); 

Readstring  (dummy,!); 
info[13] PROBE :  ’+dummy; 
end;  ( ReadIDStrings ) 

var 

s  :  string; 

error  :  integer; 


begin  (ImportDDT) 

SCALE ; =true; 

PrintText  ('Enter  DDT  filename:  ',1,22); 
readln  (filename); 

if  fllename[2]  <>  ':'  then  if  fllenome[1]  <>  '\'  then 
filename: =OefaultDataDir+ ' \ ' +f ilcname; 
if  NOT  EXIST  (filename) 
then  begin 

PrlntErrorMsg  (’File  does  not  exist !', 1 , 1 9 , false , RespCh  ) ; 

PrintText  ('Your  Choice?  ',1,22);  ClrEOL; 
end  (then) 
else  begin 

TRANS: "false; 

ORIG : "true ; 

ACCEPT : "true; 

PrintText  ('Scale  data  to  real  volues?  ’,1,20); 
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repeat 

DummyChar : <ReadKey ; 

until  (UpCase( DummyChar)  in  [ ‘Y’ , ’N’ , ENTER]  ) ; 
write  ( UpCase( DummyChar )) ; 

if  (UpCase(DummyChar)» 'N' )  then  SCALE. “folse; 

Assign  (Name, filename); 

Reset  ( Name ) ; 

ReadlDStrlngs; 

NumFreqs : -NumPolnts  dlv  2; 
for  i;-0  to  NumPoints-1  do  begin 
readln  (Namo.s); 
if  {s[1]  -  ■■•) 
then  s:=’0'+s 

else  if  ((s[1]  =  •-’)  AND  (s[2]  =  •.')) 
then  begin 
s[1]:=-0’: 
s : = ' - ' +s; 
end;  (else  if) 

Val  ( s , ampl^[i] , error ) ; 
tlme''[i]  ;  -  l»delta ; 
if  SCALE  then 

ampl^Cl]  ;  ■■ompl'Cl]  “(S'VoltsDiv*! ronsfer/NumVert Points ) ; 
end;  (for) 

Close  (Nome); 
end;  (else) 
end;  (ImportDDT) 

^***##»*HH**»»##*»*HH»tt»*»»*l»****»*»»»**H»*t'#IH*l**»*»*»«*»»»tH»M**«***H**t*#»««**»****«««<*«* 

(«»»  This  procedure  lists  the  directory  of  the  current  (logged)  drive, 

(»«»»»»««»«»*»•*»****»«»«•*»»»«**«••»«»«»»»»»»•#»*•»«••»»«••»•«»•»•*»*»•' 

procedure  DlskDlrectory ; 
const 

MaxDlrectoryEntrles  =  200; 

DefaultDrive  *  0; 

Search  *  $30;  (search  for  directories  and  files 

type 

MaxEntries  =  1 . .MaxDirectoryEntrles: 

Colors  =  1 . , 8; 


NamR 

EntryDir 

DefaultDir 

buffer 

temp 

DlrColor 

DlrBack 

EntryNumber 

NumEntrles 

NumScreens 


ch 

Drive 

CurrMlnX 

CurrMoxX 

CurrMinY 

CurrMaxY 

temp_lnt 


array  [ 1 .. MaxDirectoryEntrles]  of  string  [12]; 
array  [1 . .MaxDirectoryEntrles]  of  boolean; 
string; 
string; 

SearchRec ; 

byte; 

byte; 

byte; 

byte; 

byte; 

byte: 

byte; 

byte; 

char; 

byte; 

byte; 

byte ; 

byte; 

byte; 

longint; 
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begin  {DlskDirectory } 

CurrMlnX ; -succCLoCWindMln ) ) ; 

CurrMinY : «succ( Hl( WindMln ) ) ; 

CurrMoxX :  <succ(  Lo(Wlndlviax) ) ; 

CurrMoxY : -succ(Hl(WindMax) ) ; 

Window  (1,1,80,25); 

DirColor: =abs((7-ForeColor)  mod  16); 

DlrBock  : -abs((7-BackColor )  mod  16); 

ClrScr; 

GetDir  (DefoultDrlve, DefoultDlr ) ; 

ChDir  (DefoultDotoDlr); 

FillChor  (NamR,SlzeOf(NamR),0); 

FillChor  (buffer, SlzeOf (buffer ) , 0) ; 
buffer[0] ; -chQr(0 ) ; 

PrlntText  ('File  mask;  ',1,1);  reodln  (buffer); 
if  (length(buffer)  =  0) 
then  begin 
buffer: 

if  DefaultDataDir[2]  =  ’  ;  ’ 

then  Drive: =ord(UpCase(DefaultDatQDlr[l] ))-ord('A’ )+1 
else  Drive: -DefoultDrive; 

PrlntText  ( DefoultDotoDir , 12 , 1 ) ; 
end  (then) 
else  begin 

if  buffer[2]  =  ’ : ’  (Get  drive  number) 

then  begin 

Drive: =ord( UpCase( buf fer[1 ] ) )-(ord( ’ A’ )-1 ) ; 

If  length(buffer)  »  2  then  buffer : =buffer+' ; 
end  (then) 
else  begin 

if  DefaultDataDir[2]  =  ’ : ’ 

then  Drive: =ord( UpCase(DefoultDatoDir [1 ] ))-ord(’A')+1 
else  Drive; “DefoultDrlve; 
end;  (else) 
end;  (else) 

EntryNumber ; *0; 

FlndFlrst  (buf fer, search , temp ) ; 

if  (DosError  -  0)  AND  (temp.Attr  =  Directory)  then  begin 
($1-)  ChDir  (buffer);  ($1+) 
if  lOResult  =  0  then  buf  fer  :  =  ‘ ; 

FindFirst  (buffer , search , temp ) ; 
end;  (if) 

while  (DosError  =  0)  do  begin 

EntryNumber : “Succ( EntryNumber ) ; 

NamR[EntryNumber] ; “temp.Nome; 
if  temp.ottr  =  Directory 

then  EntryDir  [EntryNumber] ; =true 
else  EntryDir  [EntryNumber] : =folse; 

FindNext  (temp); 
end;  (while) 

NumEntries : -EntryNumber ; 

NumScreens; =(NumEntrles-1 )  dlv  72  +1; 
if  (NumEntries  >=  1) 
then  begin 

EntryNumber; =1 ; 

for  z:-1  to  NumScreens  do  begin 
for  y : =3  to  20  do 

for  x:-1  to  4  do  begin 
GotoXY  (20*x-19,y); 
if  EntryDir[EntryNumber] 
then  begin 

TextColor  (DirColor); 

TextBockground  (DlrBock); 
end  (then) 
else  begin 


TextColor  (ForeColor); 
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TextBackGround  (BackColor); 
end;  (else) 
write  (NomR[EntryNumber] ) ; 

En try Number : «succ( EntryNumber ) ; 
end;  (for) 

if  (NumScreens  >1)  then  if  (z  <  NumScreens)  then  begin 
PrintText  (’Press  any  key  for  more  entries 1 , 24 ) ; 
ch : -ReodKey ; 

ClrScr ; 

PrintText  ('File  mask:  ’ +buffer . i . 1 ) ; 
end;  (if) 
end;  (for) 
end  (then) 
else  begin 

PrintErrorMsg  (’File  not  found!  ’ , 4, 5, false, ch ) ; 
end;  (else) 

GotoXY  (1,22); 

TextColor  (ForeColor); 

TextBockground  (BackColor); 
temp_lnt ; =DiskFree  (Drive)  div  1000; 
if  Drive  >  0 

then  ch : =char(Orive+ord( ' A’ )-1 ) 
else  ch : = ’ C’ ; 

write  (’Drive  ',ch,’:  has  ’,temp_int,’  kB  free.’); 

($1-)  ChDir  (DefaultDir);  ($1+) 

ch : =char( lOResult ) ;  (Dummy  ossignment  ) 

PrintText  (’Press  any  key  to  return  ...’,1,24); 
ch : =ReodKey ; 

ClrScr; 

Window  (1,1,80,25); 

Window  (CurrMinX , CurrMlnY , CurrMaxX , CurrMoxY ) ; 
end;  (OiskDirectory ) 

procedure  ReodlnfoLlnes; 

var 

ch  ;  char; 
int  ;  byte; 

begin  (ReodlnfoLlnes) 

Window  (1,1,30,25); 

ClrScr; 

GotoXY  (1,1); 
for  lnt:=1  to  Moxlnfo  do 
wrlteln  (lnfo[int]); 

PrintText  (’Press  any  key  to  return  to  the  File  I/O  menu  ...’,1,25); 
ch : -ReadKey ; 

ClrScr; 

Window  ( StartColumn- 1 ,2.80,25); 
end;  (ReodlnfoLlnes) 

procedure  FilelOMenu; 


begin 

(»»*  Set  up  window,  print  FllelO  Menu,  prompt  for  choice.  ««*) 

ClrScr; 

PrintText  (’File  I/O  Menu’, 11,1); 

PrintText  (’Select  Option  by  typing  o  number :’, 1 , 3) ; 

PrintText  Save  Data  to  disk  ’.9.6); 

PrintText  (’2.  Retrieve  Data  from  disk  ’,9,8); 


PrintText  (’3.  Delete  Data  from  disk  ’,9,10) 
PrintText  (’4.  Import  DDT  file  from  disk  ’,9,12) 
PrintText  (’5.  Disk  Directory  ’,9,14) 
PrintText  ('6.  Dlsploy  Information  Lines  ’.9,16) 
PrintText  (’9.  Exit  to  Main  Menu  ’.9,18) 
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A-3.6  CreateWaveform 

Unit  CreateWaveform  creates  one  of  four  kinds  of  waveforms: 

1.  damped  sine  wave, 

2.  double  exponential, 

3.  reciprocal  double  exponential,  and 

4.  general  exponential  sum. 

The  damped  sine  wave  is  defined  as 

g(t)  =  A  e"“'  sin(2n/t  +  0)  . 

The  double  exponential  is  defined  as 

g(/)  =  A(c-“'-e^)  . 

The  reciprocal  double  exponential  is  defined  as 


The  general  exponential  sum  is  defined  as 

n 

1=1 

After  the  user  inputs  the  various  parameters  required  to  create  one  of  these 
waveforms,  he  is  given  the  option  of  adding  noise  to  it.  The  amount  of 
noise  added  is  defined  by  the  user  as  a  given  signal-to-noise  ratio,  input  in 
decibels  (dB). 
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unit  CreoteWavefortn; 


Interfoce 
uses 
Crt, 
Global ; 


procedure  AnalyticWaveform; 


implementation 


procedure  AnalyticWaveform; 


choice 

RespCh 


(*  Choice  of  waveforms  to  create 


procedure  AnalyticMenu ; 


begin  (AnalyticMenu) 

ClrScr ; 

Window  ( StartColumn-1 , 2,80, 25) ; 

PrintText  (’Create  Woveform  Menu', 9,1); 

PrintText  ('Select  waveform  to  creote  by  typing  a  number 1 , 3 ) ; 
PrintText  (’1.  Damped  Sine  Wave  ',9,6); 

PrintText  (’2.  EMP  Double  Exponential  ',9,8); 

PrintText  (’3.  Reciprocal  Double  Exponential ’, 9, 1 0) ; 

PrintText  (’4.  General  Exponential  Sum’, 9, 12); 


PrintText  ('9.  Exit  to  Main  Menu 
PrintText  (’Your  Choice? 

GotoXY  (14,22); 
repeat 

RespCh : »ReadKey ; 

until  (RespCh  in  [ '  1 '  .  .  ' 4 ’ , ’ 9 ’ ] ) ; 
choice :  ■=ord(  RespCh ) -or d(  '  0 '  ) ; 
if  choice  <>  9  then  begin 
NumPointS: =TNArraySi2e ; 
NumFreqs  : =TNArraySlze  div  2; 
end;  (if) 
end;  (AnalyticMenu) 


'  .9,14) 

'.1.22) 


procedure  MakeDampSlne; 


A 

alpha 

t 

beta 

cycles 

phi 

dummy 


integer; 
real ; 


real; 
real ; 
real ; 
real ; 
real ; 

GraphName ; 


begin  (MakeDampSlne) 

PrintText  ('Damped  Sine  Wave ' , StartColumn+8. 2 ) ; 


PrintText  ('This  wave  is  of  the  form  ’.1,5); 
write  (’A  ♦  exp( -alpha»t )  •  sln(2*PI»f''t  +  phi).'); 
repeat 

PrintText  ('Period  of  wave  =  ’,1,8); 

GotoXY  (18,8);  readln  (dummy); 
if  dummy  =  ''  then  dummy :='0’; 

Strlng_to_Volue  ( dummy , beta , dummy) ; 
until  (beta  <>  0); 
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repeat 

PrlntText  ('Number  of  cycles  =  ’,1.10); 

GotoXY  (20,10);  readln  (dummy): 
if  dummy  =  ''  then  dummy :=’0’; 

Strlng_to_Value  ( dummy , cycles. dummy) ; 
until  (cycles  <>  0); 
repeat 

PrlntText  ( ' A  -  ’.1,12); 

GotoXY  (5,12);  readln  (dummy); 
if  dummy  =■  ’’  then  dummy:  =  '0'; 

String_to_Value  ( dummy , A , dummy ) ; 
until  (A  <>  0); 

PrlntText  ('alpha  =  ',1,1A);  readln  (dummy); 
if  dummy  =  ''  then  dummy :=’0’; 

String_to_Value  ( dummy, alpha, dummy) ; 

PrlntText  ('phi  (degrees)  =  ’,1,16);  readln  (dummy); 
if  dummy  =  ''  then  dummy .=' 0 ’ ; 

String_to_Value  ( dummy , phi , dummy) ; 
phi: =phi*pi/180; 

for  i:=0  to  NumPolnts-1  do  begin 
t : = beta »i "cycles /(NumPoints-1 ) ; 
tlme~[i] : =t ; 

ampl~[l] ; =A»exp( -alpha* t )»sin( 2«PI*t/beta+phi  ) ; 
end;  (for) 

TRANS: =false; 

GRIG: =true; 

ACCEPT : -true; 
end;  (MokeDompSlne ) 

procedure  MokeDoubleExp; 

var 

ch  :  char; 

i  :  integer; 

A  ;  real; 

alpha  :  real; 

t  :  real; 

beta  ;  real; 

tlmeofmax  :  real; 
max  time  :  real: 
dummy  :  GraphNome; 

begin  (MokeDoubleExp) 

PrlntText  ( ' EMP  Double  Exponential StortColumn+8. 2 ) ; 
PrlntText  ('This  wave  is  of  the  form  ’,1.5); 
write  ('A  »  [exp(-a*t)  -  exp(-b*t)] . ’ ); 
repeat 

PrlntText  (’Maximum  amplitude  =  ’,1,8);  readln  (dummy) 
if  dummy  -  ’’  then  dummy :-’0’; 

String_to_VQlue  ( dummy , A , dummy ) ; 
until  (A  <>  0); 
repeat 

PrlntText  (’risetime  =  ’,1,10); 

GotoXY  (12,10);  readln  (dummy); 
if  dummy  =  ’’  then  dummy: -’0’; 

Strlng_to_Value  ( dummy , beta, dummy) ; 
until  (beta  >  0); 
repeat 

PrlntText  (’falltime  =■  ’,1,12): 

GotoXY  (12,12):  readln  (dummy); 
if  dummy  =  ’’  then  dummy :=’0'; 

Strlng_to_Value  ( dummy, alpha, dummy ) ; 
until  (alpha  >  0); 
maxtime: -3*alpha: 
alpha:=ln(10)/alpha; 
beta  :=ln(9)  /beta; 

80 


tSiSSSfe?: 


APPENDIX  A 


timeofmax ; -InC  beta/alpha )/ ( beta-alpha ) ; 

A:  -A/(exp(  -alpha*tlmeofinax)-exp(-beta»tlmeofmax) ) ; 
for  i;-  0  to  NumPolnts-1  do  begin 
t :  =maxtlme*i/(NuinPoints-1 ): 
time*[i]  ;  -t; 

an)pl^[i]  :  =A»(exp( -alpha»t  )-exp( -beta't ) ) ; 
end;  (for) 

TRANS: =falso: 

ORIG: -true; 

ACCEPT : =truo; 
end;  (NakeDoubleExp) 

procedure  MakeReclpDoubleExp; 


Integer; 
real ; 
reol ; 
real ; 
real ; 
real ; 
real ; 

GraphName; 


begin  (MakeReclpOoubleExp) 

PrlntText  (’Reciprocal  Double  Exponential StnrtColumn+8, 2) ; 
PrintText  ('This  wave  is  of  the  form  ’,1,5); 
write  (’A  /  {exp[a»(t-t0)]  -  exp[b*( t-t0)] ) . ’ ) ; 

PrintText  (’Initial  time  *  ’,1,8);  readln  (dummy); 
Strlng_to_Value  ( dummy , t0, dummy ); 

PrintText  (’Maximum  time  =  ’,1,10);  reodln  (dummy); 
String_to_Volue  (dummy, beta, dummy); 

PrintText  (’A  -  ’,1,12);  readln  (dummy); 

String_to_Value  (dummy , A, dummy ) ; 

PrintText  (’a  =  ’,1,14);  readln  (dummy); 

Strlng_to_Value  (dummy , alpha, dummy) ; 

PrintText  (’b  *  ’,1,16);  readln  (dummy); 

Strlng_to_Value  ( dummy, b, dummy); 
for  1 : =0  to  NumPoints-1  do  begin 
t:  ■=beta'‘i/(NumPoints-1  ); 
time*[i] : =t; 

ompl~[i] : =A/(exp(alpha*( t-t0) )-exp(b*(t-t0 ) ) ) ; 
end;  (for) 

TRANS: =false; 

ORIG: =true; 

ACCEPT : -true; 

end;  (MakeReclpDoubleExp) 
procedure  MakeGeneralSum; 


i 

J 

A 

alpho 

t 

beta 

NumTerms 

dummy 


integer; 
Integer; 
real ; 


integer; 

GraphName; 


begin  (MakeGeneralSum) 

PrintText  (’General  Exponential  Sum’ , StartColumn+8, 2) ; 
PrintText  (’This  wave  is  of  tne  form  ’,1,5); 
write  (’SUM  A»exp(a*t ) . ’ ) ; 
repeat 

PrintText  (’Maximum  time  -  ’,1,8); 
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GotoXY  (16,8);  reodln  (dummy); 

If  dummy  •  ’’  then  dummy :«’0’; 

Str'lng_to_Volue  (dummy ,  beta,  dummy  ) ; 
until  (beta  >  0); 
for  1; *0  to  NumPolnts-1  do  begin 
t: *beta*l/(NumPolnts-1 ) ; 
tlme“[l] : 
ampl*[l] : -0; 
end;  (for) 

PrlntText  ('Number  of  exponential  terms;  ’,1,10); 

GotoXY  (30,10);  reodln  (dummy); 

If  dummy  -  ’’  then  dummy ;-=’0’; 

Strlng_to_Value  ( dummy , t , dummy ) ; 

NumTerms: »round(t) ; 

GRIG; *folso; 

for  1:-1  to  NumTerms  do  begin 
GotoXY  (1,14);  ClrEOL; 

GotoXY  (1,16);  ClrEOL; 

GotoXY  (1,12);  wrlteln  (’Exponential  term  #’,1); 

PrlntText  (’A  =  ’,5,14);  ClrEOL;  reodln  (dummy); 

If  dummy  »  ’’  then  dummy;e’0’; 

Strlng_to_Value  ( dummy , A , dummy ) ; 

If  NOT  ORIG  then  If  A  <>  0  then  ORIG:=true; 

PrlntText  (’a  -  ’,5,16);  ClrEOL;  reodln  (dummy); 

If  dummy  =  ’’  then  dummy :*’0’; 

Strlng_to_Value  (dummy , alpha, dummy ) ; 
for  j;=0  to  NumPolnts-1  do 

ampl^[j]  :  =A'‘oxp(alpha*tlme"[j]  )  +  ampl''[j]; 
end;  (for) 

TRANS: -false; 

ACCEPT : -true; 
end;  (MakeGeneralSum) 

procedure  AddNolse; 

var 

charcholce  :  char;  (*•  Add  noise?  *) 

dummy  ;  GraphName;  (•  Scale  value  of  noise  *•) 

Scale  :  real;  ("  Scole  value  of  noise  •) 

max_r  :  real;  (*  Max  value  of  waveform  '*) 

max  1  :  Integer;  (*  Index  of  max  value  of  woveform  ♦) 

1  :  integer;  (*  Counter  variable  *) 

noise  :  real; 

begin  (AddNolse) 

PrlntText  (’Add  noise  to  waveform  (y/n)?  ’,1,20); 
repeat 

charcholce: -ReadKey; 
charcholce; =UpCase(charcholce) ; 
until  (charcholce  In  [’ Y ’, ’N’ , ENTER] ) ; 

If  (charcholce  =  ENTER) 
then  write  ( ’N’  ) 
else  write  (charcholce); 

If  (charcholce  -  ’Y’)  theg  begin 

PrlntText  ( ’ Slgnal-to-Nolse  ratio  (dB)  =  ’,1,22);  read  (dummy): 

If  dummy  -  ' ' 

then  Scale: >1000 

else  Strlng_to_Value  ( dummy . Scale, dummy ) ; 
max_l : =0; 

for  1.-1  to  NumPolnts-1  do 

If  ampl'Cl]  >  ampl"[max_l]  then  mox_l:=l; 
max_r : =ompl“ [max_l] ; 

Scale:  =max_r*exp( ( -Scale/10)'*ln(  10) ) ;  (converts  dB  to  real  #) 
Randomize; 

for  1.-0  to  NumPolnts-1  do  begin 
noise : -Scale* random; 
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atnpl“[i] ;  =ompl“[i]+nolse; 
end;  (for) 
end;  (if) 
end;  (AddNoise) 


Make  ;  boolean;  (*  Has  o  woveform  been  created?  *) 

Jin  { AnolytlcWaveform) 

AnalyticMenu ; 

Window  (1,1,80,25); 

ClrScr; 

Moke: =true; 
case  choice  of 

1:  MakeDampSine ; 

2;  MakeDoubleExp ; 

3;  MokeRecipDoubleExp ; 

4:  MakeGeneralSum; 

9:  begin 

Make : =false; 
end ; 

end;  (case) 

if  Make  then  AddNoise; 

I;  (AnalyticWaveform) 


) 


( Initialization) 
(Initialization ) 
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li 
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GraphWaveform 

Unit  GraphWaveform  displays  a  graph  of  the  data.  The  graph  defaults  to  a 
linear  graph  for  time-domain  data,  a  log  graph  for  the  magnitude  of  the 
frequency-domain  data,  and  a  log-linear  graph  for  the  phase  of  the 
frequency-domain  data.  The  following  procedures  are  contained  in  this 
file: 


1.  ClearWindow-clears  a  portion  of  the  screen. 


2.  PrintMenu-displays  the  graph  menu. 


3.  ClearMenu-removes  the  graph  menu. 


4.  GraphData-graphs  the  data  on  the  screen. 


5.  Changeinterval -changes  the  endpoints  of  the  interval  to  be  graphed. 


6.  OutputScreen-prepares  the  screen  to  be  printed. 


7.  ChangePlotType-changes  to  any  of  the  four  possible  plot  types. 


8.  GraphResults— performs  the  following: 


a.  Initialize  system 

b.  Repeat 


( 1 )  Option  1 :  Output  Screen 

(2)  Option  2:  Change  Plot  Type,  Intervals 

(3)  Option  3:  Reset  Parameters 

(4)  Option  9:  Finished 


until  finished. 
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GraphResults  plots  either  the  time  domain  doto  or  the  frequency 
domain  data,  as  determined  by  the  value  of  parameter  PlotType.  The 
data  is  either  plotted  over  the  whole  interval,  or  over  a  user 
defined  subinterval.  Additionally,  o  hord  copy  may  be  mode  of  the 
current  screen,  a  zoom  factor  may  be  given,  or  the  type  of  plot  may 
be  changed.  Initially  the  plot  is  drawn  as  a  log-log  plot.  Four 
types  of  plots  are  defined: 


1 . 

Linear  x, 

linear  y. 

*  •  *  ) 

2. 

Log  X, 

log  y. 

«  M  «  ^ 

3. 

Log  X , 

linear  y. 

*  «  *  ^ 

4. 

Linear  x, 

log  y. 

«  «  »  ^ 

unit  GraphWaveform; 

interface 

uses 

Crt, 

Graph , 

{$U  c:\pascal4\graphix\drawgraf.tpu)  DrawGraf, 
Global , 

GrophText; 

procedure  GraphResults  (PlotType  ;  char); 


implementation 

procedure  GraphResults  (PlotType  :  chor); 
const 

NormSize  *  1 : 


MinFirst 

MaxLast 

first 

last 

RightEnd 
Lef tEnd 
tempx 
max imum 
response 
temp 

ViewDONE 

Title 

XTitle 

YTitle 

TitlePos 

j 

Plot 

Plot^REO 

PlotMAG 

PlotPHASE 

dummy 


integer 
integer 
integer 
integer 
integer 
real ; 
real ; 
real ; 
real ; 
byte ; 
real ; 
boolean 
string ; 
integer 
integer 
integer 
byte : 
byte : 
booleon 
boolean 
boolean 
char : 


*  Loop  counter 

*  Smollest  point  thot  con  be  graphed. 

*  Largest  point  thot  can  be  graphed. 

*  Subintervol  setup:  groph  from 

*  first  to  last  points  of  Temp. 

*  Subintervol  setup:  user 

*  inputted  endpoints. 

*  Temp  vor  for  swopping  values. 

*  Longest  volue  of  maximum. 

*  Choice  of  options. 

*  Vorioble  for  swapping  volues. 

*  Done  viewing  graph? 

*  Title  of  graph. 

*  X  coordinate  to  print  title. 

*  Y  coordinate  to  print  title. 
Position  of  ’Title:'  in  title. 

Temp  counter  vorioble. 

Plot  type. 

Frequency  doto  to  be  plotted*’ 
Mognitude  of  frequency  data? 

'*  Phose  of  frequency  data*’ 
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procedure  CleorWindow  ( x  1 . y_1 . x_2 . y  2  :  integer); 

K.*) 


\r\i  wvu  w\!  w  »rj  w  mj  iru  wm 


*r> 

v»s 


ec 


V 
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V  :  ViewPortType; 

begin  {ClearWindow} 

GetViewSettings  (v); 

SetViewPort  (x_1 , y_1 , x_3 , y_2 , ClipOff ) : 

ClearViewPort; 

with  V  do 

SetViewPort  (x1 , yl , x2 , y2, Clip) ; 
end;  (ClearWindow) 

procedure  PrintMenu; 

begin  (PrintMenu) 


PrintText 

( ' Options ; 

. 

Print  Screen 

’ .23,22); 

PrlntText 

(' 

2. 

Change  Parameters 

’ ,23,23); 

PrintText 

(' 

3. 

Reset  Parameters 

’ .23,24); 

PrintText 

(■ 

9. 

Exit  to  Main  Menu 

'  .23,25); 

»■ 

end;  (PrintMenu) 
procedure  CleorMenu; 
vor 

x_1 , y_1 , x_2, y_2  :  integer; 

begin  (CleorMenu) 

Text_To_Cart  (1,  21,x_1,y_1); 
Text_To_Cart  (80, 26 , x_2 , y_2) ; 
x_2 : =pred(x_2 ) ; 
y_2 : 'predC  y_2) ; 

ClearWindow  (x_1 , y_1 , x_2, y_2 ) ; 
end;  (CleorMenu) 


GraphOato  graphs  the  data.  Initially,  time  data  is  grophed  on  a 
linear  (type  1)  graph,  magnitudes  are  graphed  on  log-log  (type  2) 
graphs,  and  phase  is  plotted  on  a  semi-log  (type  5)  groph. 


procedure  GrophData; 


X 

PlotXYPtr; 

y 

PlotXYPtr; 

Xl 

real  ; 

x2 

real ; 

yi 

real ; 

y2 

real ; 

error 

byte; 

ErrStr 

strlng[3] ; 

1 

Integer ; 

begin  (GrophData) 
new  (x);  new  (y); 
for  i:=first  to  last  do  begin 
x~[i-f irst+1 ] : ^OutArrayX'Ci] ; 
y"[i-first+1]: =OutArrayV~ [ 1 ] ; 
end;  (for) 

SetText Style  ( Default Font , VertDlr , NormSlze) ; 
lef tx : =2*TextHeight  ('H'); 

SetText Style  ( Def au ItFont , HorizDir , NormSlze ) ; 
r ightx ; *7“ ( ( GetMaxX+ 1 )  dlv  8); 
topy : =5“( TextHelght  ('H')  dlv  2); 
if  GrophlcsCord  <>  HercMono 
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fV  «  X-  x; 
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then  bottomy : »3»( (GetMaxY+1 )  dlv  4) 

else  bottomy : =3»( (GetMaxY+1 )  dlw  4)  -  2»TextHeight  ('H'); 
SetVlewPort  (0, 0, GetMaxX , GetMoxY, CllpOn) ; 

ClearWindow  (0,0, GetMaxX , GetMoxY ) ; 

DrawGraph  (x, y , last-flrst+1 , Plot , 

leftx , topy , rlghtx , bottomy . x1 , x2, y1 , y2, ‘ ’ , ’ ' , error ) ; 
if  error  <>  0  then  begin 
str  (error , ErrStr) ; 

PrintText  ('[Error  '+ErrStr+'  in  drawing  routine .]’, 23 , 1 0 ) ; 
end;  (if  error) 
dispose  (x);  dispose  (y); 
end;  (GrophDato) 


Chongelntervols  divides  the  array  to  be  graphed  into  subintervols 
from  LeftEnd  units  to  RlghtEnd  units,  os  input  by  the  user. 


procedure  Chongelntervols; 


LeftEndStrlng 

RightEndStrlng 

dummystring 

old_last 

old_first 

x1 ,x2,y1 ,y2 


integer; 

string; 

string; 

string; 

Integer; 

integer; 

integer; 


(«  Left  endpoint  +  multiplier 
(*  Right  endpoint  +  multiplier 
(»  dummy  units  string  returned 
(»  store  old  right  endpoint 
(»  store  old  left  endpoint 
(••  Window  coordinotes  of  menu 


begin  (Chongelntervols) 
old_last; "lost; 
old_flrst; -first; 

(•»»  Set  up  interval  to  be  plotted.  •••) 

FillChor  ( LeftEndStrlng , SizeOf ( LeftEndStrlng) , 0 ) ; 

PrintText  ('Interval  from  ',23,22); 
reodln  (LeftEndStrlng); 
if  length(LeftEndString)  >  0 

then  String_to_Value  ( LeftEndStrlng, LeftEnd, dummystring) 
else  LeftEnd: =0; 

FillChor  (RightEndStrlng , SizeOf(RightEndString) , 0) ; 

PrintText  ('  to  ',23,23); 

reodln  (RightEndStrlng); 
if  length  (RightEndStrlng)  >  0 

then  String_to_Value  (RightEndStrlng, RightEnd, dummystring ) 
else  RlghtEnd: =0u t Ar ray X" [Max Lost]  ; 
if  LeftEnd  >  RightEnd  then  begin 
tempx: -LeftEnd; 

LeftEnd; -RightEnd; 

RlghtEnd: -tempx; 
end;  (if) 

if  LeftEnd  <  OutArrayX~[MinFirst]  then  LeftEnd: =OutArrayX*[MlnFirst] ; 
if  RightEnd  >  OutArroyX' [MoxLost]  then  RlghtEnd : -OutArroyX'LMoxLost] ; 
first: -MinFlrst; 
lost: -MoxLost: 
i : -MinFirst; 

while  ( ( OutArroyX*  [  1  ]  <=  LeftEnd)  AND  (i  <  MoxL.nst))  do  l:=succ(l); 
first : =1 ; 
i : -MoxLost; 

while  ( ( OutArroyX" [ 1 ]  >=  RlghtEnd)  AND  (i  >  MinFlrst))  do  l:=pred(i); 


lost : -1 ; 

if  (lost-first)  <  5  then  begin 

PrintText  (’Too  few  points  to  plot!  ’,23,25); 
Buzzer ; 

lost: -old  lost; 
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first; =old_flrst; 
end;  {then} 
ClearMenu; 

end;  {Changelntervols) 


( . . . . . . . . 

^  *** 

{»**  OutputScreen  sets  up  the  screen  for  a  hard  copy,  then  calls  the 
(***  PrintScreen  routine  to  produce  the  hard  copy. 

. . . . . . 


«  «  « ^ 
•  «  » ^ 
»  «  «  ^ 

«  »  « ^ 
•  « ^ 


procedure  OutputScreen; 


PlotX  ;  Integer;  {*  coordinotes  to  draw  the  units  at  *) 
PlotY  ;  integer;  (*  coordinates  to  draw  the  units  at  *) 
labels  :  string; 

T  :  TextSettingsType; 


begin  (OutputScreen) 

ClearMenu; 

PrlntText  ('Horizontal  units:  ’.1,23); 
readln  {lnfo[MaxInfo-3]); 

PlotX :  ={rightx+leftx)  dlv  2  +  10«TextWidth  (’W); 
PlotY : =bottomy+2 ; 

OutTextXY  ( PlotX, P lotY, lnfo[MaxInf 0-3] ); 

PrlntText  ('  Vertical  units:  ’,1.24); 
GetTextSettlngs  (T); 
readln  ( info[MaxInfo-2] ) ; 

SetUserCharSize  (1,3, 1,2); 

SetTextStyle  ( Default Font, VertDir , NormSize) ; 
SetText Justify  (CenterText , CenterText) ; 

PlotX : =leftx-TextHelght  (’H’); 

PlotY; =(bottomy+topy)  div  2; 

OutTextXY  (PlotX, PlotY, lnfo[MaxInfo-2] ); 
SetTextStyle  (DefaultFont , HorlzDir .NormSize) ; 
SetTextJustlfy  ( T , Horlz . T . Vert ) ; 

ClearMenu ; 

PrlntText  (’Title  of  graph:  ’,1,23); 
readln  ( info[MaxInfo-1 ] ) ; 

PrlntText  ('Sub-Title:  ’,1,24); 

readln  ( info[MaxInfo] ) ; 

ClearMenu ; 

XTltle : =40-( length( lnfo[MaxInfo-1 ] )  div  2); 
PrlntText  ( lnfo[Maxlnfo-1 ]  .XTltle.l); 

XTltle : =40-( length( lnfa[MaxInfo] )  div  2); 

PrlntText  ( info [Max Info] , XTltle, 2); 

PrintScreen ; 

info [Max  Inf 0-1 ]:  =  ' Title :  ’ tinfo[MaxInfo-1 ] ; 

lnfo[MQxInfo]  : = ’ Sub-Ti tie:  ’ +info[MaxInfo] ; 

PrintMenu ; 

end;  (OutputScreen) 


. . . . . . 

(  *  »  » 

(**“  ChongePlotType  changes  the  plot  number  or  the  intervol  endpoints. 
(»**»  assumed  that  the  window  boundories  are  olreody  drawn. 

. . . . . 


•  «  •  ^ 
»  »  •  ) 

*  *  » j 

*  *  *  j 

*  *  * ) 
»  *  *  ^ 


procedure  ChongePlotType; 


ch  :  Char; 

NewPlotNum  :  byte; 
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begin  (ChongePlotType) 

Set Viewport  (0.0, GetMoxX , GetMaxY . CllpOn ) ; 
ClearMenu ; 


PrlntText 

( ' Option ; 

1  . 

Linear  Plot 

’ .23,21  ) 

PrlntText 

(' 

2. 

Log  Plot 

’ .23,22) 

PrlntText 

(' 

3. 

Log-Linear  Plot 

* .23,23) 

PrlntText 

(’ 

4. 

Lineoi — Log  Plot 

’ ,23,24) 

PrlntText 

(' 

5. 

Chonge  Interval 

’ ,23,25) 

repeat 

ch : =ReadKey ; 
until  (ch  in 

NewPlotNum:  =orcl(  ch  )-ord(  ’  0  ’  ) ; 
ClearMenu ; 

if  (NewPlotNum  in  [1..4]) 
then  Plot : “NewPlotNum 
else  if  (NewPlotNum  =  5) 
then  Chongelntervols; 
if  PlotPHASE  then 
if  Plot  =  Log 

then  Plot:=  LogLin 
else  if  Plot  =  LinLog 
then  Plot:“  Linear; 
GraphDoto; 

PrintMenu ; 

end;  (ChongePlotType) 


begin  (GrophResults) 

PlotMAG  : “(UpCase(PlotType)  =  'M'); 

PlotPHASE : =(UpCase( PlotType)  =  ’P’); 

PlotFREO  : “PlotMAG  OR  PlotPHASE; 
if  PlotFREO 
then  begin 

MlnFlrst; “0; 

MoxLost  : “NumFreqs-1 ; 
if  PlotMAG 

then  Plot: “Log 
else  Plot : “LogLin ; 
for  l:“MinFirst  to  MoxLost  do  begin 
OutArrayX''[ij  :  “freq'‘[l] ; 
if  PlotMAG 

then  OutArrayY"[i] ; “mag"[l] 
else  OutArrayY~[i] : =phase~[i]“100/PI ; 
end;  (for) 
end  (then) 
else  begin 

MinFl rst : “0 ; 

MoxLost  : “NumPolnts- 1 ; 
for  l:=MinFlrst  to  MoxLost  do  begin 
OutArroyX'Ci]: =time“[i] ; 

OutArrayY“[l] : =ampl'[i] ; 
end;  (for) 

Plot ; “Linear ; 
end;  (else) 
first; “MinFirst; 
lost  : “MoxLost : 

InltGroph  ( GrophicsCord , GrophicsMode . ’ ’ ); 
SetVlewPort  (0,0. GetMoxX , GetMox Y . Cl IpOn ) ; 

If  GrophicsCord  <>  HercMono 
then  SetColor  (White); 

GrophDoto ; 

VlewDone : =  fol se ; 

PrintMenu ; 
repeat 
repeat 
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dummy : >ReadKey ; 

until  (dummy  in  [  '  1  '  .  .  '  3 ’ . ’ 9 ’ ]  ) ; 
response: -ord( dummy )-ord( ’0’ ); 
cose  response  of 
1:  OutputScreen ; 

2:  ChongePlotType; 

3:  begin 

first : -MinFirst ; 
lest  :^f'!axLast; 
if  PlotMAG 

then  Plot:=Log 
else  if  PlotPHASE 
then  Plot:-LogLln 
else  Plot: =Linear; 
GrophOoto; 

PrintMenu ; 
end; 

9:  ViewOONE : =true ; 
end;  (cose) 
until  ViewOONE; 

CloseGroph ; 

TextColor  (ForeColor); 
TextBockGround  (BockColor); 

ClrScr ; 

end;  (GrophResults) 
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DigitizeWaveform 

Unit  DigitizeWaveform  contains  routines  to  digitize  a  waveform,  using  the 
asynchronous  routines  of  file  Async  (see  sect.  A-3.11)  to  talk  to  the 
digitizer  through  the  COM  port.  The  procedures  in  this  file  are  as  follows: 

1.  Rotate_Waveform— rotates  a  waveform  from  the  user’s  coordinate  sys¬ 
tem  to  the  digitizer’s  coordinate  system. 

2.  Draw_Waveform-draws  the  digitized  wave. 

3.  Initialize_Digitizer-initializes  the  digitizer. 

4.  Read_Digitizer— reads  a  point  from  the  digitizer. 

5.  Read_Key board-- scans  keyboard  input  for  either  an  ESCAPE  or  EN¬ 
TER  being  pressed. 

6.  Set_Up_AxeS"Uses  first  four  input  points  to  create  x-  and  y-axes. 

7.  Add_Comments-adds  comments  at  the  end  of  the  data  file.  These 
comments  are 

a.  test  point, 

b.  test  type, 

c.  attenuation  factor, 

d.  probe  number, 

e.  x-axis  units, 

f.  y-axis  units,  and 

g.  additional  comments. 

These  particular  comment  fields  were  chosen  to  suit  the  author’s  purposes; 
they  may  be  changed  without  affecting  the  operation  of  the  program. 
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^ »»»« 
^ ««» 

^ «»» 

^  ««K 

^  #** 

^  «»«l 

^  »»« 

^  ««« 

^  »««« 


Digitizer  is  to  read  data  directly  from  the  digitizing  pod,  then 
perform  analysis  on  that  data  until  it  represents  the  "actual" 
waveform  in  the  photograph.  The  digitizer  used  is  the  Micro 
Digi-Pad  6"x6"  Electromagnetic  Type  7  digitizer  from  GTCO  Corp. 
The  input  parameter  DatoToDigltize  determines  whether  to  digitize 
time  or  frequency  domain  data. 


«  »  «  ^ 
«  «  «  ^ 
»»«  ^ 


***  ) 
***  ) 


unit  DigitizeWaveform; 


interface 

uses 

Crt, 

Async , 
Graph , 
DrawGraf , 
Global , 
GraphText ; 


procedure  Digitizer  (  DataToDigi tize  ;  char); 


(* 


implementation 

procedure  Digitizer  (  DatoToDigltize  :  char); 


const 

Reset_Command 

Polnt_Command 

parity 

baud_rate 

data_bits 

stop_bits 

PauseLength 

ShortPauseLength 

MlnX 

MoxX 

MlnY 

MaxY 

NormSlze  :  byte 


'RS'  ; 
’PI  ’  ; 
’N'  ; 
9600: 
8; 

2; 

250; 
10; 
100; 
2000; 
200: 
1800: 
1 ; 


(• 


Reset  digitizer  to  power-up  * 

Set  digitizer  to  point  input  • 

•  Set  digitizer  to  no  parity 

•  Set  digitizer  to  9600  Baud 

•  Set  digitizer  to  8  bits  per  word 
»  Set  digitizer  to  two  stop  bits 

•  Pause  after  sending  commands 

•  Delay  between  digitizer  bytes 

•  Left  edge  of  digitizer  work  area 

•  Right  edge  of  digitizer  work  area 

•  Bottom  edge  of  digitizer  work  areo 

•  Top  edge  of  digitizer  work  orea 

•  Normol  size  of  defoul t  font 


chi  ,ch2.ch3.ch4.ch5 

char ; 

(• 

input  from  digitizer 

•) 

ln2 , ini , in4 . In5 

integer ; 

(• 

integer  (ch) 

♦) 

STOP 

boolean ; 

(“ 

done  yet? 

*) 

i 

integer ; 

(* 

counter  variable 

*) 

INCOMING 

boolean ; 

(« 

valid  dota  coming  from 

digitizer? 

*) 

EMPTY 

boolean ; 

{" 

is  input  buffer  empty? 

*) 

VALID  PORT 

boolean ; 

(• 

is  a  device  connected 

to  COM? 

*) 

quit 

char ; 

{« 

done  viewing  picture? 

*) 

min  time 

real ; 

(• 

minimum  time 

*) 

max  time 

real ; 

(• 

maximum  time 

•) 

min  amplitude 

real ; 

(* 

minimum  amplitude 

*) 

max  amplitude 

real ; 

(- 

maximum  amplitude 

•) 

horiz  units 

string; 

{• 

horizontal  axis  units 

•) 

vert  units 

string ; 

(* 

vertical  oxis  units 

•) 

w 

; 

^  w  *»» 
^  t»  *nt 


RotateWaveform  tronsforms  each  point  (x'.y')  in  oblique 
coordinates  to  point  (x,y)  in  rectongular  coordinates.  This  is 
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(****» 

( *** 

(  M** 

(  *** 

(*»**» 

(  *«* 

(  *♦»* 

(  ***** 


done  to  ensure  true  horizontal  and  verticol  axes.  The  specific 
steps  performed  ore 

1.  Calculate  true  origin;  sot  equal  to  (x1,y1). 

Determine  scaling  factors  and  units. 

Transform  oblique  coordinates  to  rectongular  coordinates. 
Eliminate  coordinate  axes  Informotion . 

Eliminate  non-sequential  dota  points. 


2. 

3. 

4. 

5. 


procedure  Rotate_Waveform; 


I 


If 


I 


const 


epsilon  *  1 ; 

x0,  y0 

real 

mr 

real 

mx 

real 

my 

real 

r 

real 

rx 

real 

TV 

real 

theta 

real 

phi 

real 

omega 

real 

i 

integer 

J 

Integer 

k 

integer 

dummy 

string; 

total_amplltude 

real ; 

xfactor 

real ; 

yfactor 

real ; 

delta_x 

real ; 

delta_y 

real ; 

coordinates  of  true  origin 
slope  of  rodius  axis 
slope  of  digitized  x  axis 
slope  of  digitized  y  axis 
mognitude  of  rodius  vector 
length  of  digitized  x  axis 
length  of  digitized  y  axis 
phose  of  rodius  vector 


(• 


counter  variable 
counter  varioble 
counter  variable 
time  plus  multiplier,  units 
amp/dlv  •  number  of  dlv 
X  scaling  factor 
y  scaling  foctor 
diff  between  x  coor, 
dlff  between  y  coor, 


origin 
origi n 


begin  {Rotate_Waveform) 

(«*•  Calculate  origin  ***) 

mx  :  =(TempYPtr''[2]-TempVPtr''[1]  )/(TempXPtr''[2]-TempXPtr~[l  ]  ) ; 
if  (abs  <TempXPtr''[4]-TempXPtr“[5] )  <  epsilon) 
then  x0 ; =(TempXPtr"[3]+TempXPtr“[4] )/2 
else  begin 

my :  =■(  TempYPtr"[4]-TempYPtr~[5]  )/(TempXPtr"[4]-TempXPtr~[5]  ) ; 
x0 :  =(TempYPtr~[2]-TempYPtr~[3]+my*TempXPtr"[3] 

-mx*TempXPtr~ [2] ) / ( my-mx ) ; 

end;  (else) 

y0 : *TempYPtr“ [2]+mx“(x0-TempXPtr~[2] ) ; 

TempXPtr''[0] :  =X0; 

T  empYPtr" [0] : =y0 ; 


(***  Determine  scaling  factors  • 

delta_x : ^TempYPtr" [2] -x0 ; 

delta_y : =TempYPtr" [2] -y0 ; 

rx ; =sqrt( sqr( delto_x )+sqr( delta_y ) ) ; 

delta_x : =TempXPtr“[4]-TempXPtr"[5]  ; 

delta_y : =TempYPtr* [4] -TempYPtr* [3]  ; 

ry  :  =sqrt( sqr( delta_x )+sqr( delta_y ) ) ; 


•) 


if  (UpCase(DataToDlgltlze)  =  'F') 
then  begin 

FrlntText  ('Minimum  frequency:  ’.22,21); 
read  (dummy); 

Strlng_to_Value  ( dummy , mln_time, horlz_uni ts ) ; 
PrlntText  (’Maximum  frequency:  ’.22,21);  ClrEOL; 
GotoXY  (41,21);  read  (dummy); 

Strlng_to_Value  ( dummy , max_time , hor lz_unl ts ) ; 

93 


APPENDIX  A 


«  «  »  ^ 
«  «  »  ^ 
»  *  «  ^ 
«  «  *  ^ 

»  «  »  ^ 


•) 


•) 


I 


I 
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xfactor ;  =(niax_tlmo-mln_tlme)/rx; 

PrlntText  (’Minimum  amplitude:  ’,22,21); 

GotoXY  (41,21);  read  (dummy); 

Strlng_to_Value  (dummy ,mln_amplitude, vert_units) ; 
PrlntText  (’Maximum  amplitude;  ’,22,21); 

GotoXY  (41,21);  read  (dummy); 

Strlng_to_Value  (dummy , max_amplltude, vert_units ) ; 
yfactor : =(max_amplltude-mln_amplltude)/ry ; 
end  (then) 
else  begin 

min_time: -0; 

PrlntText  (’Maximum  time:  ’,22,21);  ClrEOL; 
read  ( dummy ) ; 

Strlng_to_Value  (dummy , max_time, horiz_un its ) ; 
xfactor: =max_tlme/rx ; 
mln_amplitude: =0; 

PrlntText  (’Total  amplitude:  ’,22,21); 

GotoXY  (39,21);  reod  (dummy); 

Strlng_to_Value  (dummy ,max_amplitudo, vert_un its ) ; 
y factor: =max_amplltude/ry ; 
end;  (else) 

PrlntText  ( ’  ’  ,22,21 ); 

(»»»  Switch  from  input  coordinates  to  rectangular  coordinates 
delta_x:  =TempXPtr''[2]-x0; 
delta_y ;  -TempYPtr''[2]-y0; 
theta: “Orctan  (delta_y/delta_x); 
delta_y :  ■'TempYPtr''[3]-y0; 
if  delta_y  <  epsilon 
then  begin 

delta_y ; =TempYPtr“[4]-y0; 
delta_x; =TempXPtr*[4]-x0; 
if  delta_x  <  epsilon 
then  phl:.-PI/2 

else  phl:*arctan  (delta_y/delta_x); 
end  (then) 
else  begin 

delta_x: =TompXPtr*[3]-x0; 
if  delta_x  <  epsilon 
then  phi:  ■■PI/2 

else  phl:-arctan  (delta_y/delta_x): 
end;  (else) 
omega: -pnl-theto; 

for  l:-5  to  NumPolnts  +  4  do  begin 

delta_x : -(TempXPtr*[l]-x0)«cos(theta)+ 

( T  emp  YPt  r"  [l]-y0)'*cos(  omega+ theta ) ; 
dolta_y :  ■■(TempXPtr~[i]-x0)*sln(  theta )+ 

( TempYPtr“[l]-y0)*'sln(omega+theta) ; 

TempXPtr“[l]  :  =(delta_x'’xfactor  +  min_tlme); 

TempYPtr" [l] :=( delta_y*y factor  +  min_amplitude) ; 
end;  (for) 

(«*«  Eliminate  coordinate  axes,  non-sequential  Information, 
if  (UpCase(DataToDlgitlze)  ’F’) 
then  begin 

TempXPtr“[0] : -TempXPtr" [5] ; 

TempYPtr"[0] : -TempYPtr'ES] ; 

1  :  -1  ; 
j:-6; 

end  (then) 
else  begin 

TempXPtr" [0] : =0; 

TempYPtr*[0] : =0; 

TempXPtr~[1 ] : -TempXPtr" [5] ; 

TempYPtr"[1 ] : -TempYPtr"[5] ; 

1  :  -2; 
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J:-6: 

inc  (NumPoints ,  1 ) ; 
end;  {else} 
k:=0; 
repeat 

while  TempXPtr“[j]  <=  TempXPtr~[i-1 ]  do  begin 
inc  (J , 1 ): 
inc  ( k , 1 ) : 
end;  {while} 

TetnpXPtr''[l]  ;  -TempXPtr" [  ; 

TempYPtr''[i]  ;  =TempYPtr~ [ J ]  ; 
inc  {1,1}; 
inc  (J . 1 ); 

until  {  i+k-NumPoints } ; 
dec  {NumPoints, k}; 
end;  {Rotate_Waveforms} 


( . * . * . . . . . . . . 

( ... 

{...  Draw_waveform  sets  up  o  window  for  drawing  the  digitized  waveform, 
(...  then  draws  it. 

. . . . . . . 


procedure  Draw  Waveform; 


X 

PlotXYPtr; 

y 

PlOtXYPtr; 

Xl 

real ; 

x2 

real; 

yi 

real ; 

Y2 

real; 

error 

byte; 

1 

integer; 

begin  {Draw_Waveform} 
new  {x);  new  (y}; 

ClearVlewPort ; 
leftx:=GetMaxX  dlv  8; 
rlghtx : =7.1eftx ; 
bottomy : =3.(GetmaxY  dlv  8); 
topy: =7*{bottomy  dlv  3); 
for  i:=1  to  NumPoints  do  begin 
x“[i] ; .TempXPtr~[i]  ; 
y"[l] : =TempYPtr"[l] ; 
end;  (for} 

DrawGraph  {x ,  y ,  NumPoints,  1 , leftx, topy , rightx, bottomy , 

x1 , x2 , y 1 , y2, ' ’ , ' ’ , error ) ; 


dispose  (x);  dispose  (y); 
end;  {Draw  Woveform} 


InltiallzeDlgltlzer  opens  the  COM  port  {port  SerlalPort,  as 
selected  from  the  Advanced  Options  Menu;  the  default  is  COM! : ) 
then  sends  commands  to  the  digitizer  to  reset  it  to  power  up 
conditions,  then  set  it  to  the  point  mode.  The  input  buffer  is 
then  emptied. 


procedure  Inltlallze_Dlgltlzer; 
begin  { Initial IzeDlgltlzer} 
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VALID_PORT: =true; 

Async_Inlt; 

if  NOT  Async_Open  ( SerialPort ,  baud_rate, parity , data_blts , stop_bits ) 
then  begin 

write  (’Invalid  port!’); 

VALID_PORT: =false; 
end  (then) 
else  begin 

Async_Send_String  ( Reset_ConKnand ) ; 

Async_Send_Str ing  ( Point_Comntand  ) ; 

Delay  ( PauseLength ) ; 

repeat  until  NOT  Async_Buffer_Check  (chi); 
end;  (else) 

end;  ( Initlalize_Dlgltlzer ) 

■*  M  «  « 

•  Read_Dlgltlzer  tests  if  there  is  a  charocter  in  the  input  buffer. 

”  If  yes,  then  the  next  four  characters  are  read.  (The  Digi-Pad  **•* 

“  digitizer  uses  five  bytes  per  input  point.)  The  input  buffer  is 
”  then  emptied.  Note  that  a  delay  MUST  occur  between  each  buffer  *•* 

»  check,  or  the  computer  will  not  recognize  the  informotion.  »«*' 


procedure  Read_Dlgitlzer ; 

begin  (Read_Dlgitizer} 

if  Async_Buf fer_Check  (chi)  then  begin 
Delay  (ShortPauseLength ) ; 

if  Async_Buffer_Check  (ch2)  then  in2 ; =integer(ch2 )  AND  $3F 
Delay  (ShortPauseLength); 

if  Async_Buffer_Check  (chj)  then  tn3 : =integer(ch3 )  AND  $3F 
Delay  (ShortPauseLength); 

if  Async_Buffer_Check  (ch4)  then  ln4: =integer(ch4)  AND  $3F 
Delay  (ShortPauseLength); 

if  Async_Buf fer_Cheok  (ch5)  then  in5 ; =integer(ch5  )  AND  $3F 
Inc  ( i , 1 ) ; 

TempXPtr''[i]  1  =(  in3  shl  6)  OR  in2; 

TempYPtr^[i] : =( ins  shl  6)  OR  in4; 

PutPixel  ( round( TempXPtr'Ii] ), round( TempYPtr*[i] ) . white) : 
repeot  until  NOT  Async_Buf fer_Check  (chi); 
end;  (if) 

end;  ( Read_Digitizer ) 


(*♦*** . * . . . . . * . 

(***  Read_Keyboard  detects  either  on  ENTER  or  ESCAPE  key  being  pressed, 
(•»»  otherwise,  keyboard  Input  is  ignored. 


procedure  Read_Keyboard ; 


begin  (ReadKeyboord) 

if  keypressed  then  begin 
chi : =ReadKey; 
if  chi  =  #13 

then  STOP:=true 

else  if  chi  =  #27  then  begin 

PutPixel  (  round(  TempXPtr"  [l  ] ) .  round(  TempYPtr"'  [l]  ), block); 
dec  (1,1): 

SetColor  (DrawColor); 
end;  (else) 
end;  (if) 

end;  ( Read_Kevboord ) 
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Set_Up_Axes  uses  the  first  two  points  input  os  the  left  and  right 
enpoints  of  the  x  axis,  and  the  next  two  points  os  the  top  and 
bottom  of  the  y  axis. 


procedure  Set_Up_Axes ; 


correct  ;  char; 

OKAY  :  boolean; 

begin  {Set_Up_Axes) 
repeat 

PrintText  ('Enter  x  axis  coordinates:  ’.22,21); 

i:=0; 

repeat 

Read_Digitizer; 

Reod_Keyboard; 
until  1*2; 

Line  ( round(TempXPtr*[1  ]  ) ,  round( T6mpYPtr''[l  ]  ) , 
round(TempXPtr^[2] ) , round(T6mpYPtr~[2] ) ) ; 
PrintText  ('Enter  y  axis  coordinates:  ’.22,21); 
repeat 

Read_Dlgitizer ; 

Read_Keyboard; 
until  1*4; 

Line  ( round(TenipXPtr''[3]  ) .  round(T6mpYPtr''[}]  ) , 
round(  TempXPtr''[4]  ),  round(TempYPtr“[4]  ) ) ; 
PrintText  ('Are  axes  correct?  ’,22,21); 

Buzzer; 

correct ; *ReadKey ; 
if  (UpCase( correct)  •  'Y') 
then  OKAY;*true 
else  begin 

OKAY: *false; 

ClearVlewport; 

SetViewPort  (MinX , MlnY.MoxX .MoxY, ClipOn  ) ; 
STOP: *false; 
end;  (else) 
until  OKAY; 
end;  ( Set_Up_Axes ) 


Add_Comnients  is  used  to  store  descriptive  Information  with  the  data 
os  comments.  These  descriptors  include 
1  .  Test  Point . 

2.  Test  Type. 

3.  Attenuation  factor. 

4.  Probe  Number. 

5.  x-axls  units. 

6.  y-oxls  units. 

7.  Any  additional  comments. 


procedure  Add  Comments; 


vor  i  :  integer; 


begin 

PrintText  (Test  Point: 


,22,21);  read  (info  [1]); 


I 
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PrlntText  (’Test  Type: 

’ ,22.22): 

read 

{ Info 

[2]) 

PrintText  (’Attenuation: 

’ ,22.23); 

reod 

( Info 

[3]) 

PrintText  (’Probe  Number 

:  ’,22,24); 

read 

(  info 

[4]) 

PrlntText  ( ’Comments: 

■  ,22,25); 

read 

( Info 

[7]) 

info[1 ] 

-'Tost  Point: 

' +lnfo[l]  ; 

info[2] 

-’Tost  Type: 

’+lnfo[2]; 

info[3] 

- ’ Attenuotlon ; 

’ +lnfo[3] : 

info[4] 

-’Probe  Number; 

’+lnfo[4] ; 

info[5] 

-’X-Axls  units: 

•  •fhori2_units: 

lnfo[6] 

-’Y-Axts  units; 

’+vert  units: 

lnfo[7] 

-’Comments: 

’ +lnfo[7] ; 

for  ir=8  to  Maxlnfo  do  In fa[ i] : -blank ; 
end;  { Add_Comments) 


( 


) 


begin  (Digitizer) 

InltGroph  (GrophlcsCord, GropblcsMode, '•); 

SetTextStyle  ( TrlplexFont , HorlzDl r  NormSize): 
ietVlewPort  (MlnX , MlnV, MoxX , MoxV, CllpOn ) ; 

SetColor  (DrowColor); 

STOP; = false, • 

InltlQllze_Digltlzer,• 
if  VALIDPORT  then  begin 

repeat  until  NOT  Asvnc_Buf fer_Check  (chi); 
while  keypressed  do  chi : =ReadKey ; 

Set_Up_Axes ; 

PrlntText  (’Enter  x,y  coordinate  pairs,  ’,22,21); 

PrintText  (’Press  ESC  to  erase,  or  ENTER  to  f inlsh . ’ , 22 , 2 J ) ; 

repeot 

Read_Dlgitizer; 

Read_Keyboard ; 
until  STOP; 

PrlntText  (  ’  ’,22,21); 

PrlntText  (  ’  ’ ,22,23); 

NumPolntSi -1-4; 

If  (NumPolnts  >=  5) 
then  begin 

Rota  te_Wave  f  orm ; 

Draw_Waveform; 

Async_Send_String  (Reset_Conmand) ; 

Async_Close; 

Add_Comrnents ; 

PrlntText  (’Strike  any  key  to  return  to  Moin  Menu . ' , 22 , 20 ) ; 
ORIG : -true ; 

TRANS: -false; 

ACCEPT : -false; 
time* : -TempXPtr* ; 
ampl* :  -Temp'fPtr* ; 
end  (then) 
else  begin 

PrlntText  (’Too  few  points  input.  ’,22,21); 

PrlntText  (’Strike  any  Key  to  continue  ...’,22,23); 

ORIG: -false; 

TRANS: -false; 

ACCEPT:-false; 
end;  (else) 

Quit : -ReadKey ; 
end;  (If  VALIDPORT) 

RestoreCRTMode ; 

TextColor  (ForeColor); 

TextBackground  (BackColor); 

ClrScr; 

end;  (Digitizer) 
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DrawGraf 

Unit  DrawGraf  contains  routines  which  draw  a  waveform  in  a  specified 
area  of  the  screen.  Four  types  of  graphs  may  be  produced: 

1 .  Linear  x-axis,  linear  y-axis. 

2.  Log  jc-axis,  log  y-axis. 

3.  Logjc-axis,  linear  y-axis. 

4.  Linear  x-axis,  log  y-axis. 

The  data  to  be  plotted  are  contained  in  the  arrays  pointed  to  by  Jt  and  y. 
The  first  array  contains  the  Jc-axis  information,  and  the  second  contains  the 
corresponding  y-axis  information. 

The  following  are  the  main  procedures  and  functions  contained  in  this  file: 

1 .  Drop-drops  nonpositive  points  on  a  logarithmic  axis. 

2.  MinMaxLin-finds  minimum  and  maximum  values  for  a  linear  axis. 

3.  MinMaxLog— finds  minimum  and  maximum  values  for  a  logarithmic 


4.  Skip-determines  how  many  tic  marks  to  skip  when  writing  numbers 
on  axes. 


5.  LinearAxis-draws  a  linear  axis. 


6.  LogAxis-draws  a  logarithmic  axis. 

7.  LinearScale-scales  data  for  a  linear  graph. 

8.  LogScale-scales  data  for  a  logarithmic  graph. 


9.  Graph-graphs  data. 


i; 
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In  addition,  when  program  FFT  is  started,  this  unit  checks  the  type  of 
graphics  hardware  installed.  If  the  hardware  is  incompatible  with  that  for 
which  the  program  is  configured,  then  an  appropriate  error  message  is  dis¬ 
played  and  the  program  is  aborted. 

A  limited  amount  of  error  checking  is  also  performed.  Currently,  only  two 
error  messages  are  defined.  These  are 

0:  no  error, 

1 :  zero  or  negative  value  on  log  scale. 
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unit  DrawGraf; 

interface 

uses 

graph, 

Crt, 

GraphText; 

const 

MaxPlotPoints  =  2048; 


Linear 

Log 

LogLin 

LinLog 


-  1 
=  2 
=  3 
=  4 


type 


real 

=  extended; 

PlotXYArroy 

=  array  [1 . .MaxPlotPoints]  of  real; 

PlotXYPtr 

=  “PlotXyArray ; 

Dcedure  DrawGraph  (  x 

PlotXVPtr; 

(* 

X  data  to  groph 

*) 

y 

PlotXVPtr; 

y  data  to  graph 

*) 

NumPlotPolnts 

Integer; 

{* 

num  points  in  x  ,  y 

*) 

Plot 

byte; 

(“ 

type  of  plot 

*) 

left_x 

integer; 

(* 

loft  window  edge 

-) 

top_y 

Integer; 

(* 

top  window  edge 

•) 

rlght_x 

integer; 

(• 

right  window  edge 

•) 

bottom_y 

integer; 

(« 

bottom  window  edge 

•) 

VAR  minx 

real ; 

VAR  maxx 

real ; 

VAR  miny 

real ; 

VAR  maxy 

real ; 

horlz_unlts 

string; 

c 

Horiz  axis  units 

*) 

vert_unlts 

string; 

{“ 

Vert  axis  units 

*) 

VAR  error 

byte 

(« 

error  routine 

*) 

{  error  =  0 
(  1 


); 


no  error 

2ero  or  negative  value  on  log  scole 


implementation 


const 


ml  0 

2.302585092994046; 

MajorTic 

= 

8; 

Minor! Ic 

= 

4; 

Minintervals 

= 

2; 

Moxintervols 

= 

10; 

MaxDecodes 

= 

5; 

char_size 

4; 

Power 

string  [10] 

’  1 000000000 '  ; 

LogTable 

array  [2.. 9]  of  real 

= 

(0.3010, 

0.4771  , 
0.6021 , 
0.6990. 
0 . 7782 , 
0.8451  , 
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type 

SkipType 

WrkString 

WorldType 


0.9031. 

0.9542); 


1.  .5; 

string  [20]; 
record 


NumIntervalsX 

PosInterwolsX 

NeglntervdlsX 

Numintervalsy 

Posintervalsy 

NeglntervdlsY 

NumDecadesX 

NumDecadesy 

Plotx 

PlotY 

temp 

ZeroX 

ZeroV 

SklpX 

Sklpy 

world 

char_height 
char  width 


byte ; 

byte; 

byte; 

byte; 

byte; 

byte; 

byte; 

byte; 

integer; 

integer; 

real ; 

Integer; 

Integer; 

SkipType; 

SkipType; 

Worldtype; 

shortlnt; 

shortlnt ; 


procedure  SetUpWorld  (xl,  y1 ,  x2,  y2  :  real; 

sxl , sy 1 , sx2 , sy2  :  integer); 

begin  (SetUpWorld) 
with  world  do  begin 


x_1 ; =x1 ; 

sx_1 : =sx1 ; 

< 

1 

11 

■< 

sy_1 ; “syl ; 

X  2:=x2; 

sx  2 : =sx2 ; 

y_Z:=y2; 

sy_2; =sy2; 

end;  (with) 
end;  (SetUpWorld) 

function  WhereX  (x;real)  :  Integer; 
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X-l 

real ; 

(*  minimum  volue  of  x  in  window 

*) 

sx  1 

integer 

(•  screen  coordinote  for  x_1 

•) 

Y_1 

real ; 

(*  minimum  value  of  y  in  window 

•) 

sy  1 

Integer 

(•  screen  coordinote  for  y_1 

*) 

x_2 

real; 

(*  maximum  value  of  x  in  window 

*) 

sx  2 

integer 

(*  screen  coordinote  for  x_2 

•) 

yj 

real ; 

("  maximum  value  of  y  in  window 

*) 

sy_2 

integer 

(•  screen  coordinate  for  y_2 

*) 

end;  (record) 

var 

XLinear 

boolean ; 

(* 

is  X  axis  lineor? 

•) 

YLinear 

boolean ; 

(- 

is  y  oxis  lineor? 

•) 

i 

integer; 

(* 

counter  variable 

•) 

start 

integer; 

(• 

first  nonnegotive  point  in  orroy 

*) 

ScaleX 

real ; 

(* 

scale  X  dota  to  proper  range 

•) 

ScaleY 

real ; 

(« 

scale  y  doto  to  proper  ronge 

*) 

FactorX 

integer; 

(* 

increment  on  lineor  x  axis 

•) 

FoctorY 

integer; 

(* 

increment  on  linear  y  axis 

*) 

num  of  x  intervals  to  plot 
num  of  positive  x  intervals 
num  of  negative  x  intervals 
num  of  y  intervals  to  plot 
num  of  positive  y  Intervals 
num  of  negative  y  intervals 
num  of  X  decades  to  plot 
num  of  y  decades  to  plot 
X  coordinote  to  draw  char  ot 
y  coordinate  to  drow  char  at 
temp  vor  for  swopping  coordlnotes 
X  coordinate  of  graph’s  origin 
y  coordinate  of  graph's  origin 
how  many  x  tic  monks  to  skip 
how  many  y  tic  marks  to  skip 
limits  of  values  to  be  graphed 


(*  finds  screen  coordinate  of  x  * ) 


begin  (WhereX) 
with  world  do 

WhereX :  =sx1  +  round(  ( (x-x_1 )  / (x_2-x_l )  )••(  sx_2-sx1 ) ) ; 
end;  (WhereX) 


function  WhereY  (ymeal)  ;  Integer; 


(*  finds  screen  coordinate  of  y  *) 
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b«gln  {WhereV) 
with  world  do 

WhereY; •sy_l+round( ( (y-y_1 )/{y_2-y_1 ))*(sy_2-sy_1 ) ); 
end;  (WhereY) 


procedure  DrowLlne  (x1 ,  y1 ,  x2,  y2  ;  real); 


sxl  :  integer; 
sx2  :  Integer; 
syl  Integer; 
sy2  :  integer; 

begin  (Drowtine) 
sxl : »WhereX{x1 ) ; 
syl ; •WhereY( y1 ) ; 
sx2 : «WhereX(x2 ) ; 
sy2: -WhereY(y2); 

Line  (sxl . syl , sx2, sy2) ; 
end;  (DrowLine) 

function  log10  (x;real)  ;  real; 

begin 

log10; •ln(x)/ln10; 
end; 

function  exp10  (x;reol)  :  real; 
begin 

exp10:  ■■exp(x»ln10) ; 
end; 


(•  x1  in  screen  coordinates 
(*  x2  in  screen  coordinotes 
(•  y1  in  screen  coordinates 
(•  y2  in  screen  coordinates 


procedure  Drop  ( 


Y 

Plot 

VAR  start 


PlatXYPtr; 
PlotXYPtr; 
byte; 
integer) ; 


:  integer; 
:  integer; 


(♦  number  of  nonpositive  x  elements  ♦) 
(•  number  of  nonpositive  y  elements  *) 


begin  (Drop) 
start : *1 ; 

1  :  -1  ; 

J:-1; 

if  NOT  XLlnear  then 

while  x"[l]  <=  0  do  lnc(i,1); 
if  NOT  YLlnear  then 

while  y“[j]  <=  0  do  lnc(J,1); 
case  Plot  of 
1 :  start; =1 ; 

2:  if  i  >-  J 

then  start: =1 
else  start:=J; 

3;  start :-l; 

A;  start ;=j; 
end;  (case) 
end;  (Drop) 

procedure  MinMoxLin  (  VAR  min 
VAR  max 
VAR  Scale 
VAR  Factar 
VAR  Numlntervals 
VAR  Posintervals 


Integer ; 

byte; 

byte; 
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VAR  Negintervals  ;  byte 


const 

MoxPower  •  21; 

StepSize  :  array  [1..9]  of  Integer 

-  (1,2,5,10,20,50,100,200.500); 


OKAY 

i 

delta 

MinFudge 

MoxFudge 


:  boolean; 
:  Integer; 
;  real; 

:  boolean; 
:  boolean; 


(•  Done  with  loop  yet? 

(*  Counter  uorlable 
("  Mox  -  min 

(»  Fudge  factor  for  min  computations 
(“  Fudge  factor  for  max  computations 


begin  (MinMaxLin) 
delta : =abs(max-mln ) ; 
i : =MaxPower+3 ; 
repeat 

dec  (1,3); 

Scale: =exp10( 1 ) ; 

until  ((5  <=  (delta/Scale))  AND  ( ( delta/Scale )  <  5000)); 
MinFudge: =false; 

Max Fudge : =false ; 

if  (abs(min/Scale)  >  Maxint)  then  begin 
min ; =miny 1000 ; 

MinFudge : =true ; 
end;  (if) 

if  (abs(max/Scale)  >  Maxint)  then  begin 
max: =max/1000; 

MoxFudge: «true; 
end;  (if) 
if  min  <  0 

then  min : -pred( trunc(min/Scale) ) 
else  min:=  trunc(min/Scale); 

if  max  <  0 

then  max:=  trunc(max/Scale ) 

else  max : >succ(t rune (max /Scale) ) ; 
if  max  <  0 

then  max:=0 
else  if  min  >  0 
then  mln:=0; 

if  MinFudge  then  min ; =min»1 000 ; 
if  MoxFudge  then  max: =max» 1000; 

1;-1; 

Numintervals : =10; 

OKAY : “false; 
repeat 

Factor: -StepSlzeLl] ; 

if  ( (Numlntervals'Foctor)  >=  (max-mln)) 
then  OKAY: “true 
else  l:=succ(l); 
until  (OKAY  OR  (l  =  10)); 
min : =min*Scole ; 
max : =max*Scale; 
if  (min  >=  0) 
then  begin 

Poslntervols : *NumIntervals; 

Neglntervols : =0 ; 
min ; *0 ; 

max : =NumInterval s*Factor*Scale ; 
end  (then) 
else  if  (max  <-  0) 
then  begin 

Posintervals : =0 ; 
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Negintervals; -Numintarvals; 
min :  --Niimlntervals'Factor'Scole; 
max : =  0 : 

end  {else  if) 
else  {min  <  0  <  max) 
begin 

Pos Interval s ;  ^ trunc( max / (max-mln  )<’NumIntervo Is*  1 ) : 
Negintervals : =trunc(mln/(min-max)“NumIntervals+1 ) ; 
Numintervals ; =PosIntervalstNegIntervol s ; 
min : --NegIntervals*Factor”Scale; 
max; »  PosIntervals*Foctor“Scale,- 
end;  {else) 
d;  {MinMaxLin) 


VAR 

min 

reel 

VAR 

max 

real 

VAR 

Scale 

real 

VAR 

NumDecades 

byte 

begin  {MinMoxLog) 

if  min  >  0  then  if  min  <  1 

then  min ; =exp1 0{ pred{ trunc{ log10{min)))) 
else  mln:=exp10  { trunc{ log10{min) ) ) ; 

if  max  >  0  then  if  max  <  1 

then  max:=exp10  { trunc{ log10{max ) ) ) 

else  max : =expl 0{ succ{ t rune { log! 0{ max ) ) ) ) ; 
if  {min  »  0)  then  min : =max*exp10{ -MaxDecades) ; 
NumDecades ; = round { log10{max )-log10{min ) ) ; 
if  NumDecades  >  MaxOecades  then  begin 

min ; »exp10{ round { log10{max )-MoxDecades) ) ; 
NumDecades: -MaxOecades; 
end;  {if) 

Scale : -min ; 
end;  {MlnMaxLog) 


procedure  Skip  { 


VAR  SklpNum 


integer; 
integer; 
integer ; 
SkipType 


begin  {Skip) 

if  {{d<=s/5)  AND  {i>=4)) 
then  SkipNum:=5 
else  if  {{d<=s/4)  AND  {l>-6)) 
then  SklpNum: =4 
else  if  {{d<=s/3)  AND  (l>=8)) 
then  SkipNum:=3 

else  if  {{d<=s/2)  AND  {i>=10)) 
then  SkipNum:=2 
else  SkipNum; =1 ; 
end;  {Skip) 

procedure  LinearAxis  {  axis 
min 
max 
Scale 
Factor 

Numintervals 

Posintervals 

Negintervals 

units 


integer; 


char; 
real ; 
real ; 
real ; 
integer; 
byte; 
byte; 
byte, 
string 
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J 

Plotl 

Plots 

OutScole 

OutX 

OutY 

OutFoctor 

XAXIS 

z1 

z2 

z3 

z4 

for_llmlt 
OK  to  Draw 


Integer; 

integer; 

Integer; 

integer; 

integer; 

integer; 

WrkString ; 

boolean ; 

Integer; 

Integer ; 

Integer; 

Integer; 

Integer ; 

boolean ; 

string  [20]; 


Jin  (LineorAxis) 

XAXIS:=(UpCaso(axls)  =  'I'); 
with  world  do  begin 
if  XAXIS 

then  begin 

zl.=sx_1;  z2.=sx2;  z3:=sy_1;  2A:=sy  2; 
end  ~  “ 

else  begin 

Zl:=sy_1;  22:=sy_2;  z3:=Sx_1;  z4:=SX_2; 
end ; 

end;  (with) 
if  XAXIS 

then  begin 

Plotl : =WhereX  ( 0) ; 

Line  ( Plot  1 . z3 , Plotl . z4 ) ; 

Line  (z1 ,z3,z2.z3); 

Line  (z1 , z4 , z2 , z4) ; 

PlOtX: -Plotl ; 

PlotY : =z3+char_height; 

ZeroX : -Plotl ; 

end 

else  begin 

Plotl ; -WhereY  (0); 

Line  ( z3 , Plotl , z4 , Plotl ) ; 

Line  {^5.z^  ,z3.22); 

Line  ( z4 , zl , z4 , z2 ) ; 

PlotX ; =z3-4*char_wldth ; 

PlotY : -Plotl -{char_height  div  2); 

ZeroV; -Plotl : 
end ; 

OutTextXY  (PlotX, PlotY,  '0'  ); 
for  J : =1  to  2  do  begin 

=  PosIntervals+{j-l )"( Neg  Inter  vols-Pos  Intervals  ) ; 
for  i:=l  to  for_lltiilt  do  begin 

Plots  :-PlotU(3-2»j  )”round{i-{z2-zl  )/NumIntervals  ) 

Str  ((3-2»J)-l»Factor, OutFoctor); 
if  XAXIS 

then  begin 

Line  ( Plots , z3 , Plots , z3-MajorTlc )  ; 

Line  (P lots. z4,P lots, z4+MQjorTlc); 

PlotX : =Plot2-(Length(0utFoctor )  div  2 I'chorwidth ; 
PlotY : =z3+char_helght; 

OKtoDrow; =( i  mod  SkipX  =  0); 
end  (then) 
else  begin 

Line  (z3, Plots. z3+MojorTic. Plots) ; 

Line  ( z4 , Plots . z4-MQjorTlc , Plots ) ; 

PlotX :-z3-(3  +  J  )*char_wldth ; 

PlotY: -Plot2-(chQr_height  div  2); 

OKtoDrow: -( i  mod  SkipY  =  0); 
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end; 

if  OK_to_DrQw  then  OutTextXY  ( PlotX . PlotY , OutFactor  ) ; 
end;  {for  l) 
end;  (for  J) 

If  XAXIS 


then  begin 

OutX  :  =(  (2l+z2 )  div  2)-i**char_wldth; 

OutY: =z3+3»char_helght  ; 
end  {then) 
else  begin 

OutX: =z3-( 10+MaxOecades)“char_width; 

OutY: =(z1+z2-char_helght)  div  2; 
end;  {else} 

if  (Scale  <>  0)  then  begin 

Out Scale : = round ( logi 0( Scale ) ) ; 

Str  ( OutScale , OutFactor )  ; 
if  OutFoctor  <>  '0'  then  begin 

PlotX: =OutX; 

PlotY: =OutY; 

outstr : = ’ {x10  )'; 

OutTextXY  (PlotX, PlotY, outstr); 

PlotX: =OutX; 

PlotY: =OutY-(char_height  div  2); 

outstr: ='  '+OutFactor; 

OutTextXY  (PlotX, PlotY, outstr); 
end;  (if) 
end;  (then) 
end;  (UlnearAxls) 


procedure  LogAxis  ( 


ox  is 

chor; 

min 

real ; 

max 

real ; 

Scale 

real ; 

NumDecades 

byte; 

units 

string 

vor 


1 

J 

K 

Plotl 

Plot2 

NewPlot 

OutX 

OutY 

OutScale 

OutFactor 

z1 

z2 

z3 

z4 

XAXIS 


Integer; 

integer; 

integer; 

Integer ; 

integer ; 

integer; 

integer; 

Integer ; 

integer; 

Wrkstring ; 

Integer ; 

integer; 

integer; 

Integer; 

boolean ; 


V, 


» 


» 


begin  (LogAxis) 

XAXIS: =(UpCase(axls)  =  'I'); 
with  world  do  begin 
if  XAXIS 

then  begin 


Zl : =SX_1 ; 

z2: =sx_2; 

z3 : =sy_1 

end 

else  begin 
zl : =sy_1 ; 

z2 ; =sy_2 ; 

23 : =sx_1 

end ; 

end;  (with) 
if  XAXIS 
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then  begin 

Line  (z1 , 23, z2, z3) ; 

Line  (z1 , z4, z2 , z4) ; 

end 

else  begin 

Line  (z3 , z1 , z3, z2 ) ; 

Line  (z4, Zl , z4 , z2) ; 
end; 

Plotl : -zl ; 

for  1:-1  to  NumDecades+1  do  begin 

NewPlot ; -round(z1+l*(z2-z1 )/NumDecades ) ; 
for  k.-l  to  1  do  OutFactor[k] : =power[k] : 
OutFQctor[0] : -char( l ) ; 

If  XAXIS 

then  begin 

Line  (Plotl , z3, Plotl , z3-MojorTlc ) ; 

Line  (Plotl , z4, Plotl . z4+MajorT Ic) ; 

PlotX : -Plotl -( l“char_wldth )  dlv  2; 

PlotY: -23+char_helght; 

end 

else  begin 

Line  (z3, Plotl, z3+MajorT Ic , Plotl ) ; 

Line  (z4, Plotl, z4-MojorT Ic , Plot  1 ) ; 

PlotX : -z3-(MaxDecades+1 )“char_width ; 

PlotY: -Plotl ; 
end; 

OutTextXY  (PlotX , PlotY, OutFoc tor ) ; 

If  1  <=  NumOecodes  then  for  j : -2  to  9  do  begin 

Plot2 : =round( Plotl +(NewPlot-Plot1 )«LogTable[j]); 
If  XAXIS 

then  begin 

Line  ( Plot2, z3, Plot2 , z3-MlnorT Ic ) ; 

Line  ( Plot2, z4, Plot2, z4+MlnorTlc ) ; 

end 

else  begin 

Line  ( z3, Plot2, z3+MlnorTlc , Plot2) ; 

Line  (z4, Plot2, z4'MlnorTlc , Plot2 ) ; 
end ; 

end;  (for  j) 

Plotl : -NewPlot ; 
end;  (for  1) 

If  XAXIS 

then  begin 

OutX : - ( z l  +  z2 )  dlv  2  -  4*char_wldth ; 

OutY : =z5+3*char_helght ; 

end 

else  begin 

OutX : -z3-( 10+MaxOecades)“char_wldth ; 

OutY : =(zl +z2+char_helght )  dlv  2; 
end ; 

If  (scale  <>  0)  then  begin 

Out Scale : =round( log  1 0( Scale) ) ; 

Str  { OutScale , OutFoctor ) ; 

If  OutFactar  <>  '0'  then  begin 
PlotX: -OutX;  ' 

PlotY: -OutY; 

OutTextXY  (PlotX, PlotY, ■ (x10  )'); 

PlotX : -OutX; 

PlotY: =OutY-(chor_helght  dlv  2); 

OutFoctor:-'  ’+OutFactor; 

OutTextXY  (PlotX , PlotY, OutFoctor ) ; 
end;  (if) 
end;  (then) 
end;  (LogAxls) 


procedure  LlnearScale  (  VAR  z 


:  PlotXYPtr. 


APPENDIX  A 


VAR  min  :  real; 

VAR  max  :  real: 

Scale  :  real; 

N  :  integer 

); 

var  i  :  integer; 

begin  (LineorScole) 
for  i : =1  to  N  do 

z^[i] : =2* [i] /Scale; 
min : =min/Scale ; 
max : =max/Scale; 

end;  ( LineorScole) 

procedure  LogScale  (  VAR  z  :  PlotXYPtr;* 

VAR  min  ;  real; 

VAR  max  :  real; 

Scole  :  real; 

N  :  Integer 

); 

var  i  :  integer; 

begin  {LogScale} 

for  i:=1  to  N  do  begin 

if  (2*[i]  <  min)  then  z*[i]:=min; 
z*[i] : =log10(2*[i]/Scale) ; 
end;  {for) 
min ; alog10( min /Scale) ; 
max : slog10( max /Scale) ; 

end;  {LogScale} 

procedure  GraphArray  (x  :  PlotXYPtr; 

y  :  PlotXYPtr; 

N  ;  integer); 

vor 

new_x  ;  integer; 
new_y  :  integer; 
old_x  :  integer; 
old_^y  :  integer; 
i  integer; 

begin  {GraphArray) 
with  world  do  begin 

new_x :  =WhereX  (x'*‘[l]); 
new_y :  =WhereY  (y'^[l]); 
for  i : =2  to  N  do  begin 
old_x ; =new_x ; 
old^y ; =new_y ; 
new_x ;  =WhereX  {x'*[i]): 
new_y ;  =WhereY  (v''[l]); 

Line  (old_x , old_y . new_x . new_y ) ; 
end;  {for) 
end;  {with) 

end;  {GraphArray) 

procedure  DrawGraph  (  x  ;  PlotXYPtr;  { *  x  data  to  graph  •) 

y  :  PlotXYPtr;  ( •*  y  dato  to  graph  *) 

NumPlotPoints  :  integer;  {•  num  of  points  in  A  *) 

Plot  ;  byte;  ( **  type  of  plot  ** ) 

left_x  ;  integer;  (•  left  window  edge  *) 

top_y  :  integer;  {*  top  window  edge  •• ) 

right_x  integer;  {*  right  window  edge  *) 

bottomry  integer.  (*  bottom  window  edge  •) 
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VAR  minx 

real ; 

VAR  moxx 

real ; 

VAR  mlny 

real ; 

VAR  moxy 

real ; 

horiz_unlts 

string; 

vert_unlts 

string; 

VAR  error 

byte 

begin  (DrawGroph) 
error: =0; 

SetTextStyle  (SmollFont, HorizDir , char_sl2e) ; 

char_height : -TextHeight  ('H'); 

char_width  :=TextWldth  ('W'); 

left_x : =left_x+( 1 l+MaxDecodes )“char_width ; 

bottom  y :  -bottoin_y-3»char_helght ; 

XLlneor: =( (Plot  =  Linear)  OR  (Plot  =  LlnLog)); 
yilneor ; =( (Plot  =  Linear)  OR  (Plot  =  LogLin)); 

Drop  (x , y , Plot , start ) ; 
for  i:=start  to  NumPlotPolnts  do  begin 
x“[l-start+1] : =x“[l] ; 
y~[i-start+l] : “y^Cl] ; 
end;  (for) 

NumPlotPolnts : =NumPlotPolnts-start+1 ; 

minx : ^x" [ 1 ] ; 

moxx : ^x" [ 1 ] ; 

mlny : «y*[1] ; 

moxy: “y“[1] ; 

for  1 : ■2  to  NumPlotPolnts  do  begin 
If  minx  >  x"[i] 

then  mlnx;»x*[i] 
else  If  moxx  <  x*[l] 
then  moxx: =x^[l] ; 

If  mlny  >  y*[l] 
then  mlny:-y*[l] 
else  If  moxy  <  y''[i] 
then  moxy; -y*[l]  ; 
end;  (for) 

If  (NOT  XLlneor)  AND  (minx  <=  0)  then  error:=1: 

If  (NOT  YLlneor)  AND  (mlny  <«  0)  then  error:=1; 
if  (error  =  0)  then  begin 
if  XLlneor 

then  MinMaxLin  (minx , moxx , ScoleX . FoctorX . NumlntervolsX . 

PosIntervolsX . NeglntervolsX ) 
else  MlnMoxLog  (minx , moxx , ScoleX , NumDecodesX ) ; 

If  YLlneor 

then  MinMoxLln  (mlny , moxy , ScoleY . FoctorY , Numintervol sY , 
PosIntervolsY, NeglntervolsY ) 
else  MlnMoxLog  ( mlny , moxy . ScoleY , NumOecodesY ) ; 

SetUpWorld  (minx, mlny, moxx , moxy , lef t_x . bottom_y , rightx . top_y ) ; 
If  XLlneor 


then  begin 

Skip  ( ( right_x-left_x ) , GetMoxX .  NumlntervolsX , SklpX ) ; 

LI near Ax Is  ( ' 1 ' , minx , moxx , ScoleX , FoctorX , NumlntervolsX , 
PosIntervolsX . NeglntervolsX , horizunl ts ) ; 

L 1 near SCO le  (x , minx , moxx , ScoleX , NumPlotPolnts ) ; 
end  (then) 
else  begin 

Log Ax Is  ( ' 1 ' , minx , moxx . ScoleX , NumDecodesX , hor 1 z_un its); 

LogScole  ( x , minx , moxx , ScoleX . NumPlotPolnts ) ; 
end;  (then) 

If  YLlneor 
then  begin 

Skip  ( ( bottom_y-top_y ) , GetMoxY , Numlntervo 1 sY , Sk ipY ) ; 

LlneorAxls  (' d mlny , moxy , ScoleY  FoctorY , Numlntervo IsY , 
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PosIntervalsY, NegIntervalsY, vert_unlts) ; 
LlnoarScale  (y , mlny , maxy, ScaleY, NumPlotPoints) ; 
end  {then) 
else  begin 

Log Ax is  (  ' d ' ,miny , maxy , ScoleY.NumDecodesY, vert_units ) ; 

LogScdle  ( y.mlny , maxy, ScaleY, NumPlotPoints  ) ; 
end;  (else) 
with  world  do 

SetUpWorld  (minx ,miny, maxx , maxy , sx_1 , sy_1 , sx_2 . sy_2) ; 
GraphArroy  (x,y, NumPlotPoints); 
end;  (if  error  =>  0) 
end;  (OrawGraph) 


( 


) 


van 

GrophDriver,  GraphMode,  Error  :  integer; 


procedure  CgaDriverProc ;  external; 

($L  \pQscalA\graphlx\CGA , OBJ  ) 

procedure  EgaVgaDrlverProc ;  external; 
{$L  \pascal4\graphlx\EGAVGA . OBJ  ) 

procedure  HercOriverProc;  external; 
($L  \pascal4\graphix\HERC.0BJ  ) 

procedure  SmallFontProc;  external; 

($U  c:\pascal4\graphlx\LITT.0BJ  ) 

procedure  TriplexFontProc;  external; 
($L  c : \poscol4\grophix\TRIP. OBJ  ) 


procedure  Abort(Msg  ;  string); 
begin 

Wrlteln(Msg,  ';  ',  GraphErrorMsg(GraphResult ) ) ; 
Halt(1); 
end; 


begin  (Initialization  section) 

(  Register  all  the  drivers  ) 
if  RegisterBGIdrlver(®CGADriverProc)  <  0  then 
Abort( ' CGA ' ) ; 

if  ReglsterBGIdrlver(OEGAVGADrlverProc)  <  0  then 
Abort( ’EGA/VGA' ); 

if  ReglsterBGIdriver(OHercDriverProc)  <  0  then 
Abort( ' Here ' ) ; 

{  Register  all  the  fonts  ) 
if  ReglsterBGIfont(OSmallFontProc)  <  0  then 
Abort( ’ Small ' ) ; 

GraphDriver  :=  Detect;  {  outodetect  the  hardwore  ) 

InitGraph(GraphDriver,  GraphMode,  ’’);  (  octlvote  grophics  ) 

if  GraphResult  <>  grOk  then  begin  (  any  errors?  ) 

Wrlteln( 'Graphics  Initialization  error:  ',  GrophErrorMsg(GraphDriver) ) ; 
Halt( 1 ); 
end ; 

CloseGraph ; 

end.  (Unit  DrawGraf) 


iff 
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GraphText 

Unit  GraphText  contains  two  routines: 

1 

s 

1.  Text_To_Cart;  and 

i 

i 

PrintText. 

it 

The  first  procedure  converts  text  coordinates  to  screen  coordinates  in  the 
current  graphics  system.  The  second  procedure  replaces  procedure 

PrintText  in  unit  GlobalProcedures  for  writing  text  to  the  screen  in  ^ 

graphics  mode.  fl 

hv 
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unit  GrophText; 

Interfoce 

uses 

Crt, 

Groph; 

procedure  Text_To_Cart  (  tx.ty  :  integer; 

VAR  cx,cy  ;  Integer); 


procedure  PrlntText  (s:string;  x.y: integer); 


implementation 


procedure  Text_To_Cart  (  tx.ty  :  integer; 

VAR  cx.cy  :  Integer); 

begin  (Text_To_Cart) 

cx;-(tx-1)*((GetMaxX+1)  dlv  80); 
cy : =( ty-1 )*( (GetMaxV+l )  dlv  25); 
end;  {Text_To_Cart} 


■procedure  PrlntText  (s  :  string; 

X  :  Integer; 
y  :  Integer); 

const 

NormSlze  •  1 ; 

begin  (PrlntText) 

GotoXY  (x  +  lengtb(s),v); 

SetTextSty le  (DefoultFont , HorlzDlr , NormSize) ; 
SetText Justi fy  ( Lef tText , TopText ) ; 
Text_To_Cart  (x.y.x.y); 

MoveTo  (x.y); 

OutText  (s); 

MoveTo  (x+TextWldth( s) , V ) ; 
end;  (PrlntText) 


( . * . .  . . . . . . ...) 

begin  (Initialization) 
end,  (unit  GraphText) 
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Async 

Unit  Async  contains  routines  which  allow  Turbo  Pascal  to  talk  to  an 
asynchronous  port  (COMl  or  COM2).  The  routines  were  developed  from 
Technical  Information  Sheet  number  226,  dated  August  1,  1986,  from 
Borland  International,  Inc.  The  following  routines  are  present: 

1 .  Async_Init-initializes  asynchronous  routines. 

2.  Async_Open-opens  the  COM  port;  sets  up  the  interrupt  vector  and 
data  buffer;  sets  the  baud  rate,  parity,  word  size,  and  stop  bits. 

3.  Async_Buffer_Check-reads  a  character  from  the  buffer  if  present. 

4.  Async_Send-transmits  a  character. 

5.  Async_Send_String--transmits  a  string  of  characters. 

6.  Async_Close--turns  off  COM  port  interrupts. 

7.  Async_Change--changes  COM  port  parameters  (baud  rate,  parity, 
word  size,  and  stop  bits). 


ASYNC.INC  has  been  developed  from  Technical  Information  Number  226 
from  Borland  International,  dated  August  1.  1986.  The  program  is 
highly  dependent  on  the  IBM  PC  and  PC-OOS  2.0. 


ASYNC.INC  -  Asynchronous  Communications  Routines. 


Entry  points: 

Async_Inlt 

Performs  initialization. 


Async_Open  (Port,  Baud  :  integer; 

Parity  :  char; 

WordSize , StopBits  :  integer)  :  boolean; 

Sets  up  interrupt  vector,  initialize  the  COM  port  for 
processing,  sets  pointers  to  the  buffer.  Returns  FALSE  if 
COM  port  not  installed. 

Async_Buf fer_Check  (var  C  :  char)  :  boolean 

If  a  character  is  available,  returns  TRUE  ond  moves  the 
character  from  the  buffer  to  the  parometer;  otherwise, 
returns  FALSE. 


i 

iS 


AsYnc_Send  (C  :  char); 

Transmits  the  character. 

AsYnc_Sencl_String  (S  ;  string) 

Colls  AsYhC_Send  to  send  each  character  of  S. 


ASYnc_Close 

Turn  off  the  COM  port  interrupts.  This  most  be  called  before 
exiting  the  progra,  otherwise  unpredictable  results  will 
occur  and  it  will  be  necessarY  to  reboot. 


unit  ASYhC; 


I 


Interface 


type 

real  =  extended; 
procedure  Async_Init; 


procedure  Async_Close; 

function  Async_Open  (  ComPort 
BaudRate 
Parity 

WordSize 
StopBi ts 


integer ; 
integer; 

,  char ; 
integer; 

integer  )  ;  booleon; 


function  AsyncBuf ferCheck  (var  C:char)  :  boolean; 

procedure  ASYnc_Send  (C:char); 

procedure  Async_Send_String  (S;string); 

procedure  AsyncChonge  (  BaudRate  :  integer; 

Parity  :  char; 
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WordSize  :  Integer: 
StopBlts  :  integer); 


( 


implementation 


const 

UART_THR  =  $00 
UART_RBR  =  $00 
UART_IER  =  $01 
UART_IIR  =  $02 
UART_LCR  =  $03 
UART_MCR  =  $04 
UART_LSR  =  $05 
UART  MSR  =  $06 


offset  from  bose  of  UART  registers  for  IBM  PC. 


I8088_IMR  =  $21;  (»  port  address  of  the  interrupt  Mask  Register. 

Async_Dseg_Save  :  integer  =  0;  («  Sove  DS  reg  in  Code  Segment 

(“  for  interrupt  routine. 


> 


•) 

% 

.)  I 


Async_Buf fer_Max  =  4095; 


vor 

Async_Buf f er 

Async_Open_Flag 

Async_Port 

Async_Base 

Async_IRO 

Async_Buf fer_Overf low 
Async_Buf fer_Used 
Async_MaxBuf ferUsed 


array  [0. 
boolean ; 
Integer; 
Integer ; 
integer; 
boolean ; 
integer; 
Integer; 


Async_Buf fer_Mox]  of  char; 

(“  Current  open  port  number  (1  or  2) 
(«  Base  for  current  open  port. 

(»  IRQ  for  current  open  port. 

(«  Buffer  overflow? 


*) 

•) 

♦) 

*) 


1 


) 

1 


(• 


Async_Buffer  is  empty  if  Head 


Async_6uf fer_Head 
Async_Buf fer_Tail 
Async_6uf fer_NewTall 


integer; 

integer; 

Integer; 


.  Toil  *»») 

*•  Loc’n  in  buffer  to  put  next  char. 
•  Loc’n  in  buffer  to  get  next  char. 


Async_BIOS_Port_TQble  :  array  [1..2]  of  integer  absolute  $40:0; 

(««*  This  table  is  initialized  by  BIOS  equipment  determination  code 
at  boot  time  to  contain  the  base  addresses  for  the  instolled 
(»**  async  adapters.  A  value  of  0  meons  "not  instolled." 


const 

Async_Num_Bauds  =  8; 
Async_Baud_Table 


=  ((Baud:110; 
(  Baud ; 1 50 ; 
(Baud: 300; 
( Baud : 600 : 
(Baud: 1200 
(Baud : 2400 
(Baud: 4800 
(Baud: 9600 


integer ; 
integer; 
(record) 

Bits;$00). 

Blts:$20), 

Bits:$40). 

Bits. $60), 

Bits: $80), 

Bits: $A0), 

Bits:$C0), 

Bits:$E0h; 


array  [ 1 . . Async_Num_Bauds]  of  record 

Baud 

Bits 

end 


*  »  * ) 
«  *  « ^ 


procedure  BI0S_RS232_Inlt  (ComPort, ComParm  ;  integer); 

(**•  Issue  Interrupt  $14  to  initialize  the  UART.  See  the  IBM  Technical  *»•) 
(•••  Reference  Manual  for  the  format  of  ComParm.  •**) 

vor 

Regs  ;  registers; 
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begin  (BI0S_RS232_Inlt) 
with  Regs  do  begin 

ax:-ComParm  and  $00FF;  (*  AH:=0;  AL:=ComPQrm  *) 

dx : =ComPort; 

Intr  ($14, Regs); 
end;  (with) 
end;  {BI0S_RS232_Init} 

procedure  DOS_Set_Interrupt  (v, s,o: integer); 

(««»  call  DOS  to  set  an  Interrupt  vector  *) 

vor 

Regs  :  Registers; 

begin  {DOS_Set_Interrupt) 
with  Regs  do  begin 

ax:>$2500  +  (v  and  $00FF); 
ds : »s ; 
dx ; »o ; 

MsDos  (Regs); 
end;  (with) 

end;  (DOS_Set_Interrupt) 


( . * . ****** . . . . 

(»**  ASYNCISR.INC  -  Interrupt  Service  Routine 

(*** 


***) 

«  «  «  ^ 
«  «  •  ^ 


procedure  Async_ISR; 

(»*•  Interrupt  Service  Routine.  Invoked  when  the  UART  has  received  a  •••) 
(»*»  byte  of  dote  from  the  communication  line.  Written  in  mochine  *•*) 
(••*  language,  the  assembly  code  is  shown  os  comments.  ««•) 


/• 


begin  (Async_ISR) 

(*»•  Note:  on  entry.  Turbo  Pascal  has  olreody  PUSHed  BP  and  SP.  »«*) 


■  Inline  ( 

( •  Save 

all  registers  used. 

*) 

;  $50/ 

(»  PUSH 

AX 

*) 

$53/ 

(•  PUSH 

BX 

*) 

»  $52/ 

( »  PUSH 

DX 

*) 

1 

(•  PUSH 

DS 

*) 

$FB/ 

(•  STI 

*) 

1  (“  Set  up  the  DS  register  to 

point  to 

Turbo  Pascal's  doto  segment. 

*) 

1  $2E/$FF/$56/Async  Dseg  Save/ 

(•  PUSH 

CS : Async_Dseg_Save 

*) 

•  $1F/ 

(•  POP  DS 

*) 

(*  Get  the  incoming  chorocter.  ») 
( *  Async_8uf f er[Async_Buf fer_Head] : =Chr(Port[UART_RBR+AsYnc_Bose] )  »  ) 
$8B/$16/Async_Base/  (*  MOV  DX , Async_Base  •) 
$EC/  (*  IN  AL,DX  *) 
$8B/$1E/Async_Buffer_Head/  (•  MOV  BX , Async_Buf f er_Heod  •) 
$88/$87/Async_Buffer/  (•  MOV  Async_Buffer  [BX],AL  *) 

(*  Async_Buf fer_NewHead  :=  Async_Buffer_Head  +1  *) 
$43/  (•  INC  BX  ♦) 


(*  if  Async_Buffer_NewHead  >  Async_Buf fer_Max  •) 
(*  then  Async_Buf fer_NewHead  :  =■  0  *) 
$81/$FB/Async_Buffer_Max/  (•  CMP  BX , Async_Buf fer_Max  *) 
$7E/$02/  (•  JLE  L001  *) 
$33/$DB/  (•  XOR  BX,BX  ♦) 

(*  if  Async_Buf f er_NewHead  =  Async_Buf ferTail  •) 
(•  then  Asvnc_Buf fer_Overf low  :=  true  *) 
(*  else  begin  *) 
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(*  ASYnc_Buffer_Head  ;=  Async_Buffer_NewHeod; 

(*  Async_Buffer_Used  :■  Async_Buf fer_Used  +  1; 

(*  if  Async_Buf fer_Used  >  Async_MaxBufferUsed  then 

(*  Async_MaxBufferUsed  : =  Async_Buf fer_Used ; 

(♦  end; 

( *  L001 :  then 

$38/$1E/Async_Buffer_Tail/  (*  CMP  BX,  Async_Buf fer_Tai 1 

$75/$08/  (*  JNE  L002 

$C6/$06/Async_Buf fer_Overf low/$01/  (*  MOV  Async_Buf ferOverf low, 1 

$90/  (“  NOP  generated  by  assembler 

$EB/$16/  (*  JMP  SHORT  L003 


(*  L002;  else 

$89/$1E/Async_Buf fer_Head/ 
$FF/$06/Async_8uffer_Used/ 
$8B/$1E/Async_Buffer_Used/ 
$3B/$1E/Async_MaxBuf ferUsed/ 
$7E/$04/ 

$89/$1E/Async_MaxBuf ferUsed/ 


(*  MOV  Async_Buf fer_Heod , BX 
(•  INC  Async_Buffer_Llsed 
(“  MOV  BX ,  Asvnc_Buffer_Llsed 
(*  CMP  BX , Asvnc_MQxBuf ferUsed 
(*  JLE  L003 

(«  MOV  Async_MaxBuf ferUsed , BX 


*) 

•) 

*) 

•) 


*) 

*) 

•) 

*) 

*) 

•) 

*) 

•) 

*) 

•) 


(»  L003:  end  if 

{»  disable  interrupts 

$FA/ 

(•  Port  [$20]  :=  $20; 
$B0/$20/ 

$E6/$20/ 


(»  CLI 

use  non-specific  EOI 
(*  MOV  AL,$20 
(•  OUT  $20, AL 


*) 

*) 

•) 

*) 

•) 

*) 


(•  Restore  the  lost  registers  then  use  IRET  to  return.  The  lost  *) 

(*  two  POPs  ore  required  becouse  Turbo  Pascal  PUSHes  these  regs  •) 

(»  before  we  get  control,  although  the  monual  doesn’t  show  it,  *) 

$1F/  (»  POP  DS  *) 

$5A/  (»  POP  DX  «) 

$58/  (»  POP  BX  *) 

$58/  (*  POP  AX  *) 

$5C/  (»  POP  SP  *) 

$50/  («  POP  BP  «) 

$CF);  (»  IRET  •) 

end;  (Async_ISR) 

procedure  Async_Inlt; 

(«**  Initialize  variables,  ••*) 


begin  {Async_Inlt} 

Async_DSeg_Save  :=  DSeg; 

Async_Open_FlQg  :=  FALSE; 

Async_Buf fer_0verf low  ;=  FALSE; 

Async_Buf fer_Used  :=  0; 

Async_MaxBuf  ferUsed  :  ■=  0; 

end;  {Async_Init) 


procedure  Async_Close; 

(•««  Reset  the  interrupt  system  when  UART  interrupts  no  longer  needed.  »•») 


vor 

i.m  :  Integer; 


begin 

if  Async_0pen_Flog  then  begin 

(*  Disable  the  IRQ  on  the  8259.  *) 

Inline  ($FA);  (•  Disable  the  interrupts.  *) 

i:=  Port  [I8088_IMR];  (•  Get  the  Interrupt  Mask  Register  «) 

m:-  1  shl  Async_IR0;  ( *  Set  mosk  to  turn  off  Interrupt  *) 

Port  [I8088_IMR]  : =  1  or  m; 

( *  disable  the  8250  data  ready  interrupt  • ) 
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Port  [UART_IER  +  Async_Base]  :=  0: 


(*  disable  0UT2  on  the  8250 
Port  [UART_MCR  +  Asvnc_Base]  :=  0; 

Inline  ($FB);  (*  enable  interrupts 


(*  Re-initiolize  data  areas  to  know  the  port  is  closed. 
Async_Open_Flag : *FALSE ; 
end;  {if) 
end;  { Async_Close} 


function  Async_Open  (  ComPort 

BaudRate  ; 
Parity 
WordSize  : 
StopBits  : 

(«*•  Open  a  communication  port 


integer; 
integer ; 
char; 
integer ; 
integer 


) 


booleon ; 


ComParm  ;  integer; 
i,m  integer; 


-) 

-) 

-) 


begin  { Async^Open } 

if  Async_Open_Flag  then  Async_Close; 
if  (ComPorts2)  AND  ( Async_BI0S_Port_Table[2]  <>  0) 
then  Async_Port : «2 

else  Async_Port : »1 ;  (•  Default  to  C0M1 ;  •) 

Async_Bose: »Asvnc_BIOS^Port_Table[ AsyncPort] ; 

Async_IRQ:  =  Hi(  Async_Base)-t-1 ; 

if  (Port  [UART_llR+Asvnc_Base]  and  $00F8)  <>  0 
then  Async_Open :» FALSE 
else  begin 

Async^Buf fer^Head : =0; 

Async_CJuffer_rail .  »0; 

Async_Buf fer_Overf low; =FALSE: 

(•»*•  Build  the  ComParm  for  RS232_Init.  See  the  Technica' 

(•"*  Reference  Manual  for  description.  •*•) 

ComParm : *$0000 ; 

(**•  Set  up  the  bits  for  the  baud  rote. 

i  :  =0; 

repeat 

i : *succ(  i ) ; 

until  (Asvnc_Boud_Table[i] -Baud  =  BaudRate) 

OR  (  i  =  Async_^Num_Bauds )  ; 

ComParm: ^ComParm  or  Async_Baud_TobZef i ] . Bi ts : 
i f  parity  in  [ ’ E ’ , ’ e ’ ] 

then  ComParm  : =  ComParm  OR  $0018 
else  if  parity  in  ['O’. 'o’] 

Lhen  ComParm  ; =  ComParm  OR  $0008 

else  ComParm  ;=  ComParm  OR  $0000;  (•  Defoult  to  no  parity  *) 
if  WordSize  =  7 

then  ComParm; =ComPorm  OR  $0002 

else  ComParm ;  =ComParm  OR  $0003;  (*•  Default  to  8  data  bits.  •) 


if  StopBits  =  2 

then  ComParm : =ComParm  OR  $0004 

else  ComParm: =ComParm  or  $0000;  (*  Default  to  1  stop  bit.  •) 

(*•*  use  the  BIOS  COM  port  initialization  routine  to  save  «•*) 

(•*»  typing  the  code.  ••••) 

BIOS_RS232_In i t  ( AsyncPor t- 1 , ComPorm) ; 

OOS_Set_ Interrupt  ( Async_IRQ+8. CSeg , Ofs( Async_ISR  )  ) ; 

(**•  Read  the  RE3R  and  reset  any  possible  pending  error 

(••*  conditions.  First  turn  off  the  Divisor  Access  Lotch  Bit  *•*) 


(*»•  to  allow  access  to  RBR,  etc. 

Inline  ($FA);  (*  Disable  interrupts. 

Port  [UART_LCR+Asvnc_Base] : -Port  [UART_LCR+Async_Base]  AND  $7F ; 
(***  Read  the  Line  Status  Register  to  reset  any  error  it  ** 

(*♦**  Indicates 

i:-Port  [UART_LSR+Async_Base] ; 

(***  Read  the  Receiver  Buffer  Register  in  cose  it  contains 
(***  a  character.  *' 

i ; -Port  [UART_RBR+Async_Base] ; 

(«««  Enable  the  IRQ  on  the  8259  controller.  **' 

l;=Port  [I8088_IMR];  ( *»  Get  the  Interrupt  Mask  Register. 

m:=(1  shl  Asvnc_IRQ)  XOR  $00FF; 

Port  [I8088_IMR] ; =1  AND  m; 

(••*  Enoble  the  Data  Ready  Interrupt  on  the  8250. 

Port  [UART_IER-fAsync_Bose]  ;  =$01 ; 

(*••«  Enable  0UT2  on  8250. 
i  : -Port  [LIART_MCR  +  Async_Base]  ; 

Port  [UART_MCR+Async_Base] : =i  OR  $08; 


Inline  ($F8):  (*  enable  interrupts  ** 

Asvnc_Open_Flog ; -TRUE ; 

Async_Open : -TRUE ; 
end:  (if-else) 

end;  {Async_Open) 

function  Async^Buf fer_Check  (var  C:char)  :  boolean; 

(*••  See  if  a  character  has  been  received:  return  It  if  yes.  ** 

begin  { Async_6uf fer^Check ) 

if  Async^Buf fer_Head  *  Async_Buf fer^Toil 
then  Async_Buf fer_Check ; -FALSE 
else  begin 

C; «Async_Buf fer[Async_8uffer_Toi 1]  ; 

Asvnc_0uf fer^Toil : -succ  ( Async_Buffer_Tai 1 ) : 

if  Async_0uffer_Tail  >  AsyncBuf fer^Mox  then  Async_Buffer_Tail : = 
Async^Buf fer^Used ; =Async_8uf fer_Used-1 ; 

Async_Buf fer_Check : -TRUE : 
end:  (else) 

end:  { Asvnc_Buf  fer_^Check ) 

procedure  Async_Send  (C:char); 

(*••  Transmits  o  character. 


i.m. counter  :  integer; 
begin  {Async_Send} 

Port  [UARTMCR-t-Async^Base]  ;  =$00:  ( "  Turn  on  OUT2.  OTR,  and  RTS. 

(*•-  Wait  for  CTS 
counter; -Maxint; 

while  (counter  <>  0)  AND  ((Port  [UART_MSR+Asvnc_0ose]  AND  $10) 
counter : *pred  (counter); 

(*••  Wait  for  Transmit  Hold  Register  Empty  (THRE). 
if  counter  <>  0  then  counter: *MaxInt; 

while  (counter  <>  0)  AND  ((Port  [UART_LSR+Async_Base]  AND  $20) 
counter : spred  (counter); 
if  counter  <>  0 
then  begin 

(•*•  Send  the  choracter. 

Inline  ($FA):  (*  disable  interrupts 
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Port  [UART_THR+Async_Bose]  :  =Orcl(C) ; 

Inline  ($FB);  f*  enable  interrupts 

end  (then) 
else 

write In  ( ’ <<<TIME0UT>>> ' ); 
end;  {Async_Send) 


procedure  Async_Send_String  (S;string); 
(•**  Transmit  o  string. 


i  Integer; 

begin  { Async__Send_String) 
for  i;=1  to  length  (S)  do 
Async_Send  (S[i]); 
end;  { Async_Send_Str ing } 


procedure  Async^Change  (  BoudRote  :  integer; 

Parity  ;  char; 

WordSize  :  integer; 

StopBits  :  integer); 

(•••*  Changes  communications  parameters.  The  BIOS  routines  connot  be 
(***  used  because  they  drop  DTR. 


const 

Num^Bouds  »  15; 
divisor  table  : 


array  [ 1 . . Num^Bauds]  of  record 

baud  integer; 

divisor  :  integer; 
end  (record) 

( ( baud ; 50 ;  divisor : 2304) , 

( baud ; 75;  divisor: 1536) . 

( baud : 110;  divisor : 1047) . 

( baud : 1 34 ;  divi sor :857) . 

( baud : 150;  divisor : 768) . 

( baud : 300 ;  divisor : 584) . 

( baud ; 600;  divisor : 192) . 

(baud:1200;  divisor:96). 

(baud:1800;  divisor:64), 

( baud : 2000 :  divisor : 58) , 

(baud:2400;  diviSor:48). 

(baud:3600;  div1sor:32), 

( baud : 4800 ;  divisor : 24 ) . 

(boud  7200;  divisor;16), 

(baud:9600:  divisor : 1 2 )) ; 


begin  { Async_Change ) 

(***  Build  the  Line  Control  Register  and  find  the  divisor 

(•#*  (for  the  baud  rate). 

i:=0; 

repeot 

i :  *succ  ( i ) ; 

until  (Di visor_Toble[i] . Boud  =  BoudRote)  OR  (i  =  Num^Bouds); 
dv : =Di visor_Table[ 1 ] .divisor ; 

Icr ; *0; 


r« 

vor 

*• 

» 

i 

integer ; 

dv 

integer; 

Icr 

integer ; 

’E’ 

Icr 

=  Icr 

OR 

$18; 

(' 

even 

parity 

*) 

’0’ 

Icr 

=  lcr 

OR 

$08; 

(* 

ood 

parity 

*) 

.. 

■N’ 

Icr 

=  Icr 

OR 

$00; 

(* 

no 

pority 

•) 
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'M‘  :  lcr:=lcr  OR  $28; 
'S’  :  lcr:=:lcr  OR  $38; 
else  lcr:»lcr  OR  $00; 
end;  (cose) 

case  WordSlze  of 


Icr 

=  lcr 

OR 

$00 

Icr 

=  lcr 

OR 

$01 

Icr 

=  lcr 

OR 

$02 

Icr 

=  lcr 

OR 

$03 

Ise  Icr 

=  lcr 

OR 

$04 

end;  (case) 

If  StopBlts  =  2 

then  lcr:=lcr  OR  $04 
else  lcr:=lcr  OR  $00; 
Icr: =lcr  AND  $7F; 

Inline  ($FA); 


(*  Mark  parity 
(*  Space  parity 
(*  Default  to  no  parity. 


(»  default  to  8  bits. 


(*  defoult  to  1  stop  bit. 

(*  make  certoln  the  DLAB  Is  off. 
(»  disable  interrupts. 


(»••  turn  on  OLAB  to  access  the  divisor. 

Port  [UART_LCR+Async_Base] : -Port  [UART_LCR+Async_Base]  OR  $80; 

(•••  set  the  divisor. 

Port  [Async_Base] : =Lo  (dv); 

Port  [Async_Base+1 ] : =H1  (dv); 

(••*  turn  off  the  DLAB  and  set  the  new  communications  parometers. 
Port  [UART_LCR+Async_Base] : =lcr; 

Inline  ($FB);  (»  enable  Interrupts. 

);  { Async_Change) 


•) 

•) 

•) 


•) 

*) 

•) 

•) 

**) 
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GEORGIA  INSTITUTE  OF  TECHNOLOGY 
OFFICE  OF  CONTRACT  ADMINISTRATION 
ATTN  RES  &  SEC  COORD  FOR  H.  DENNY 
ATLANTA,  GA  30332 

US  ARMY  LABORATORY  COMMAND 
ATTN  TECHNICAL  DIRECTOR,  AM.SLC-TD 

INSTALLATION  SUPPORT  ACTIVITY 
ATTN  LEGAL  OFFICE,  SLCIS-CC 

USAISC 

ATTN  RECORD  COPY,  ASNC-LAB-TS 
ATTN  TECHNICAL  REPORTS  BRANCH, 
ASNC-LAB-TR  (2  COPIES) 

HARRY  DIAMOND  LABORATORIES 
ATTN  D/DIVISION  DIRECTORS 
ATTN  LIBRARY,  SLCIS-IM-TL  (3  COPIES) 
ATTN  LIBRARY,  SLCIS-IM-TL  (WOODBRIDGE) 
ATTN  LAB  DIRECTOR,  SLCHD-NW-E 
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HARRY  DIAMOND  LABORATORIES  (cont'd) 

ATTN  CHIEF,  SLCHD-NW-EC 

ATTN  CHIEF,  SLCHD-NW-ED  (15  COPIES) 

ATTN  CHIEF,  SLCHD-NW-EE 

ATTN  CHIEF,  SLCHD-NW-P 

ATTH  CHIEF,  SLCHD-NW-R 

ATTN  CHIEF,  SLCHD-NW-RA 

ATTN  CHIEF,  SLCHD-NW-RC 

ATTN  CHIEF,  SLCHD-NW-RH 

ATTN  CHIEF,  SLCHD-NW-RI 

ATTN  CHIEF,  SLCHD-TT 

ATTN  H.  LESSER,  SLCHD-IT-EB 

ATTN  J.  0.  WEDEL,  JR.,  SLCHD-IT-EB 

ATTN  B.  ZABLUDOWSKI,  SLCHD-IT-EB 

ATTN  A.  FRYDMAN,  SLCHD-IT-RT  (2  COPIES) 

ATTN  R.  J.  CHASE,  SLCHD-NW-EC 

ATTN  A.  HERMANN,  SLCHD-NW-EC 

ATTN  C.  LE,  SLCHD-NW-EC 

ATTN  A.  NGUYEN,  SLCHD-NW-EC 

ATTN  R.  J.  REYZER,  SLCHD-NW-EC 

ATTN  D.  TROXEL,  SLCHD-NW-EC 

ATTN  R.  L.  ATKINSON,  SLCHD-NW-ED  (15  COPIES) 

ATTN  H.  E.  BOESCH,  JR.,  SLCHD-NW-RC 

ATTN  C.  FAZI,  SLCHD-NW-RE 

ATTN  R.  KAUL,  SLCHD-NW-RE 

ATTN  P.  B.  JOHNSON,  SLCHD-ST-A 

ATTN  W.  WIEBACH,  SLCHD-ST-AB 

ATTN  P.  ALEXANDER,  SLCHD-ST-AD 

ATTN  C.  ARSEM,  SLCHD-ST-AD 

ATTN  D,  M.  HULL,  SLCHD-ST-AD 

ATTN  J.  LOWE,  SLCHD-ST-AD 

ATTN  J.  DENT,  SLCHD-TA-F  (2  COPIES) 

ATTN  R.  GOODMAN,  SLCHD-TA-OS 

ATTN  J.  J.  FALTER,  SLCHD-NW-ED  (50  COPIES) 
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